A
Alen32
I have this makro which transfer values from one sheet to 21 files.
need to know which values are not transfered. I tryed to paint cell
which are not transfered with red color but that doesn't work, becaus
all cells getting red collor.
Private Sub CommandButton3_Click()
Const sSalesSheetName As String = "Ark1"
Const sCellToWriteIn As String = "AF3"
Dim salesFile(1 To 21)
salesFile(1) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\150.xls"
salesFile(2) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\180.xls"
salesFile(3) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\200.xls"
salesFile(4) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\210.xls"
salesFile(5) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\250.xls"
'salesFile(5) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\250.xls"
salesFile(6) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\280.xls"
salesFile(7) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\320.xls"
salesFile(8) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\340.xls"
salesFile(9) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\420.xls"
salesFile(10) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\430.xls"
salesFile(11) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\510.xls"
salesFile(12) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\520.xls"
salesFile(13) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\560.xls"
salesFile(14) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\590.xls"
salesFile(15) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\600.xls"
salesFile(16) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\690.xls"
salesFile(17) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\750.xls"
salesFile(18) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\770.xls"
salesFile(19) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\870.xls"
salesFile(20) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\910.xls"
salesFile(21) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\950.xls"
Dim iSalesNo As Integer
Dim wkbNew As Excel.Workbook
Dim wkbSales As Excel.Workbook
Dim wksImport As Excel.Worksheet
Dim wksView As Excel.Worksheet
Dim lRowFrom As Long
Dim lRowTo As Long
Dim bFound As Boolean
'On Error GoTo CleanUp
Set wkbNew = ActiveWorkbook
Set wksImport = wkbNew.ActiveSheet
For iSalesNo = LBound(salesFile) To UBound(salesFile)
Set wkbSales = Application.Workbooks.Open( _
FileName:=salesFile(iSalesNo))
Set wksView = wkbSales.Worksheets(sSalesSheetName)
' 2-tallet her bestemmer hvilken
' række det første kundenr findes i( Update-filen)
For lRowFrom = 2 To wksImport.UsedRange.Rows.Count
bFound = False
' 3-tallet her bestemmer hvilken række
' det første kundenrfindes i(Salgsview - filen)
For lRowTo = 3 To wksView.UsedRange.Rows.Count
If Val(wksImport.Cells(lRowFrom, 1).Value) = _
wksView.Cells(lRowTo, 2).Value Then
wksView.Cells( _
lRowTo, _
wksView.Range(sCellToWriteIn).Column _
).Value = _
wksImport.Cells(lRowFrom, 2).Value
bFound = True
Exit For
End If
Next lRowTo
If Not bFound Then
'Cells get red color if not transfered,
wksImport.Cells(lRowFrom, 1).Interior.ColorIndex = 3
End If
Next lRowFrom
Next iSalesNo
CleanUp:
Set wksImport = Nothing
Set wksView = Nothing
Set wkbNew = Nothing
Set wkbSales = Nothing
End Sub
need to know which values are not transfered. I tryed to paint cell
which are not transfered with red color but that doesn't work, becaus
all cells getting red collor.
Private Sub CommandButton3_Click()
Const sSalesSheetName As String = "Ark1"
Const sCellToWriteIn As String = "AF3"
Dim salesFile(1 To 21)
salesFile(1) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\150.xls"
salesFile(2) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\180.xls"
salesFile(3) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\200.xls"
salesFile(4) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\210.xls"
salesFile(5) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\250.xls"
'salesFile(5) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\250.xls"
salesFile(6) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\280.xls"
salesFile(7) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\320.xls"
salesFile(8) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\340.xls"
salesFile(9) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\420.xls"
salesFile(10) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\430.xls"
salesFile(11) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\510.xls"
salesFile(12) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\520.xls"
salesFile(13) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\560.xls"
salesFile(14) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\590.xls"
salesFile(15) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\600.xls"
salesFile(16) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\690.xls"
salesFile(17) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\750.xls"
salesFile(18) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\770.xls"
salesFile(19) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\870.xls"
salesFile(20) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\910.xls"
salesFile(21) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågri
efoder\Tjørnehøj opfølgning enkeltafdelinger\950.xls"
Dim iSalesNo As Integer
Dim wkbNew As Excel.Workbook
Dim wkbSales As Excel.Workbook
Dim wksImport As Excel.Worksheet
Dim wksView As Excel.Worksheet
Dim lRowFrom As Long
Dim lRowTo As Long
Dim bFound As Boolean
'On Error GoTo CleanUp
Set wkbNew = ActiveWorkbook
Set wksImport = wkbNew.ActiveSheet
For iSalesNo = LBound(salesFile) To UBound(salesFile)
Set wkbSales = Application.Workbooks.Open( _
FileName:=salesFile(iSalesNo))
Set wksView = wkbSales.Worksheets(sSalesSheetName)
' 2-tallet her bestemmer hvilken
' række det første kundenr findes i( Update-filen)
For lRowFrom = 2 To wksImport.UsedRange.Rows.Count
bFound = False
' 3-tallet her bestemmer hvilken række
' det første kundenrfindes i(Salgsview - filen)
For lRowTo = 3 To wksView.UsedRange.Rows.Count
If Val(wksImport.Cells(lRowFrom, 1).Value) = _
wksView.Cells(lRowTo, 2).Value Then
wksView.Cells( _
lRowTo, _
wksView.Range(sCellToWriteIn).Column _
).Value = _
wksImport.Cells(lRowFrom, 2).Value
bFound = True
Exit For
End If
Next lRowTo
If Not bFound Then
'Cells get red color if not transfered,
wksImport.Cells(lRowFrom, 1).Interior.ColorIndex = 3
End If
Next lRowFrom
Next iSalesNo
CleanUp:
Set wksImport = Nothing
Set wksView = Nothing
Set wkbNew = Nothing
Set wkbSales = Nothing
End Sub