Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default 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ågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\150.xls"
salesFile(2) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\180.xls"
salesFile(3) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\200.xls"
salesFile(4) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\210.xls"
salesFile(5) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\250.xls"
'salesFile(5) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\250.xls"
salesFile(6) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\280.xls"
salesFile(7) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\320.xls"
salesFile(8) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\340.xls"
salesFile(9) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\420.xls"
salesFile(10) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\430.xls"
salesFile(11) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\510.xls"
salesFile(12) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\520.xls"
salesFile(13) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\560.xls"
salesFile(14) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\590.xls"
salesFile(15) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\600.xls"
salesFile(16) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\690.xls"
salesFile(17) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\750.xls"
salesFile(18) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\770.xls"
salesFile(19) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\870.xls"
salesFile(20) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj
opfølgning enkeltafdelinger\910.xls"
salesFile(21) =
"L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris 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=521664

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Change makro


Please some help!


--
Alen32
------------------------------------------------------------------------
Alen32's Profile: http://www.excelforum.com/member.php...o&userid=32181
View this thread: http://www.excelforum.com/showthread...hreadid=521664

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Change makro


ones more please some help

--
Alen3
-----------------------------------------------------------------------
Alen32's Profile: http://www.excelforum.com/member.php...fo&userid=3218
View this thread: http://www.excelforum.com/showthread.php?threadid=52166

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Change makro


and last time please some help!


--
Alen32
------------------------------------------------------------------------
Alen32's Profile: http://www.excelforum.com/member.php...o&userid=32181
View this thread: http://www.excelforum.com/showthread...hreadid=521664

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Makro Fredrik New Users to Excel 2 May 6th 09 06:38 PM
Makro in excel Ted Excel Worksheet Functions 6 June 28th 06 02:06 PM
If with a makro Tove Excel Discussion (Misc queries) 1 April 12th 05 01:49 PM
Makro Esrei Excel Discussion (Misc queries) 1 March 1st 05 12:34 PM
Makro in Excel AndersTC Excel Programming 4 January 14th 05 04:17 PM


All times are GMT +1. The time now is 12:50 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"