![]() |
Help with macro!
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 -- Alen32 ------------------------------------------------------------------------ Alen32's Profile: http://www.excelforum.com/member.php...o&userid=32181 View this thread: http://www.excelforum.com/showthread...hreadid=523751 |
All times are GMT +1. The time now is 06:42 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com