+ Reply to Thread
Results 1 to 4 of 4

Change makro

  1. #1
    Registered User
    Join Date
    03-06-2006
    Posts
    10

    Change makro

    I have this makro which transfer values from one sheet to 21 files. I need to know which values are not transfered. I tryed to paint cells which are not transfered with red color but that doesn't work, because 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ågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\150.xls"
    salesFile(2) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\180.xls"
    salesFile(3) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\200.xls"
    salesFile(4) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\210.xls"
    salesFile(5) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\250.xls"
    'salesFile(5) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\250.xls"
    salesFile(6) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\280.xls"
    salesFile(7) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\320.xls"
    salesFile(8) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\340.xls"
    salesFile(9) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\420.xls"
    salesFile(10) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\430.xls"
    salesFile(11) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\510.xls"
    salesFile(12) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\520.xls"
    salesFile(13) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\560.xls"
    salesFile(14) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\590.xls"
    salesFile(15) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\600.xls"
    salesFile(16) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\690.xls"
    salesFile(17) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\750.xls"
    salesFile(18) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\770.xls"
    salesFile(19) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\870.xls"
    salesFile(20) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\Tjørnehøj opfølgning enkeltafdelinger\910.xls"
    salesFile(21) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågrisefoder\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

  2. #2
    Registered User
    Join Date
    03-06-2006
    Posts
    10

    Please some help

    Please some help!

  3. #3
    Registered User
    Join Date
    03-06-2006
    Posts
    10

    ones more please some help!

    ones more please some help!

  4. #4
    Registered User
    Join Date
    03-06-2006
    Posts
    10

    last time

    and last time please some help!

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1