Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Macro recorded... tabs & file names changed, macro hangs | Excel Worksheet Functions | |||
Macro Help Needed - Excel 2007 - Print Macro with Auto Sort | Excel Worksheet Functions | |||
how to count/sum by function/macro to get the number of record to do copy/paste in macro | Excel Programming | |||
macro to delete entire rows when column A is blank ...a quick macro | Excel Programming | |||
Start Macro / Stop Macro / Restart Macro | Excel Programming |