Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 78
Default Help with macro!

I got this macro here which work well. I need just one change:
I want to insert values in coulum a,b and d instead of like now a,b and c
(Workbook Destination).
Here is macro:
Private Sub CommandButton2_Click()

Dim wbBonus As Workbook, wbDest As Workbook
Dim a(), i As Long, r As Range, x
Dim b(), l As Long, k As Range, y
Dim c(), v As Long, n As Range, z
Dim d(), u As Long, m As Range, o

'Workbooks.Open Filename:="c:\bonus.xls"
Workbooks.Open Filename:="c:\Destination.xls"
Set wbBonus = Workbooks("Bonus flyt Sap-excel.xls")
Set wbDest = Workbooks("Destination.xls")
With wbBonus.Sheets("Ark1")
'HIMMERLAND
x = Application.CountIf(.Range("a:a"), "0620 TM,
smågrisefoder") + _
Application.CountIf(.Range("a:a"), "0621 TM, smågrisefoder")
+ _
Application.CountIf(.Range("c:c"), "DE1100 Himmerland")
ReDim a(1 To x, 1 To 3)
For Each r In .Range("a1", .Range("a65536").End(xlUp))
If r.Value = "0620 TM, smågrisefoder" And _
r.Offset(, 2).Value = "DE1100 Himmerland" Or _
r.Value = "0621 TM, smågrisefoder" And r.Offset(,
2).Value = "DE1100 Himmerland" Then
i = i + 1: a(i, 1) = r.Offset(, 1)
a(i, 2) = r.Offset(, 13): a(i, 3) = r.Offset(, 14)
End If
Next
'HOLSTEBRO
y = Application.CountIf(.Range("a:a"), "0620 TM, smågrisefoder") +
_
Application.CountIf(.Range("a:a"), "0621 TM, smågrisefoder")
+ _
Application.CountIf(.Range("c:c"), "DE1400 Holstebro")
ReDim b(1 To y, 1 To 3)
For Each k In .Range("a1", .Range("a65536").End(xlUp))
If k.Value = "0620 TM, smågrisefoder" And _
k.Offset(, 2).Value = "DE1400 Holstebro" Or _
k.Value = "0621 TM, smågrisefoder" And k.Offset(,
2).Value = "DE1400 Holstebro" Then
l = l + 1: b(l, 1) = k.Offset(, 1)
b(l, 2) = k.Offset(, 13): b(l, 3) = k.Offset(, 14)
End If
Next
'VESTHIMMERLAND
z = Application.CountIf(.Range("a:a"), "0620 TM, smågrisefoder") +
_
Application.CountIf(.Range("a:a"), "0621 TM, smågrisefoder")
+ _
Application.CountIf(.Range("c:c"), "DE1200 Vesthimmerland")
ReDim c(1 To z, 1 To 3)
For Each n In .Range("a1", .Range("a65536").End(xlUp))
If n.Value = "0620 TM, smågrisefoder" And _
n.Offset(, 2).Value = "DE1200 Vesthimmerland" Or _
n.Value = "0621 TM, smågrisefoder" And n.Offset(,
2).Value = "DE1200 Vesthimmerland" Then
v = v + 1: c(v, 1) = n.Offset(, 1)
c(v, 2) = n.Offset(, 13): c(v, 3) = n.Offset(, 14)
End If
Next
Dim c(), v As Long, n As Range, z
Dim d(), u As Long, m As Range, o

'DJURSLAND
z = Application.CountIf(.Range("a:a"), "0620 TM, smågrisefoder") +
_
Application.CountIf(.Range("a:a"), "0621 TM, smågrisefoder")
+ _
Application.CountIf(.Range("c:c"), "DE1200 Vesthimmerland")
ReDim c(1 To z, 1 To 3)
For Each n In .Range("a1", .Range("a65536").End(xlUp))
If n.Value = "0620 TM, smågrisefoder" And _
n.Offset(, 2).Value = "DE1200 Vesthimmerland" Or _
n.Value = "0621 TM, smågrisefoder" And n.Offset(,
2).Value = "DE1200 Vesthimmerland" Then
v = v + 1: c(v, 1) = n.Offset(, 1)
c(v, 2) = n.Offset(, 13): c(v, 3) = n.Offset(, 14)
End If












End With
With wbDest.Sheets("Ark1")
'.Cells.Clear
.Range("a2").Resize(UBound(a, 1), UBound(a, 2)).Value = a

End With

Erase a
With wbDest.Sheets("Ark2")
'.Cells.Clear
.Range("a2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End With
Erase b
With wbDest.Sheets("Ark3")
'.Cells.Clear
.Range("a2").Resize(UBound(c, 1), UBound(c, 2)).Value = c

End With
Erase c
End Sub


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 12
Default Help with macro!

haven't tested

Private Sub CommandButton2_Click()

Dim wbBonus As Workbook, wbDest As Workbook
Dim a(), i As Long, x
Dim b(), l As Long, y
Dim c(), v As Long, z
Dim r As Range
Workbooks.Open Filename:="c:\Bonus flyt Sap-excel.xls"
Workbooks.Open Filename:="c:\Destination.xls"
Set wbBonus = Workbooks("Bonus flyt Sap-excel.xls")
Set wbDest = Workbooks("Destination.xls")
With wbBonus.Sheets("Ark1")
'HIMMERLAND
x = Application.CountIf(.Range("a:a"), "0620
TM,smagrisefoder") + _
Application.CountIf(.Range("a:a"), "0621 TM,
smagrisefoder") + _
Application.CountIf(.Range("c:c"), "DE1100 Himmerland")
ReDim a(1 To x, 1 To 3)

y = Application.CountIf(.Range("a:a"), "0620 TM,
smagrisefoder") + _
Application.CountIf(.Range("a:a"), "0621 TM,
smagrisefoder") + _
Application.CountIf(.Range("c:c"), "DE1400 Holstebro")
ReDim b(1 To y, 1 To 3)

z = Application.CountIf(.Range("a:a"), "0620 TM,
smagrisefoder") + _
Application.CountIf(.Range("a:a"), "0621 TM,
smagrisefoder") + _
Application.CountIf(.Range("c:c"), "DE1200 Vesthimmerland")
ReDim c(1 To z, 1 To 3)

For Each r In .Range("a1", .Range("a65536").End(xlUp))
If (r.Value = "0620 TM, smagrisefoder" Or _
r.Value = "0621 TM, smagrisefoder") And _
r.Offset(, 2).Value = "DE1100 Himmerland" Then
i = i + 1: a(i, 1) = r.Offset(, 1)
a(i, 2) = r.Offset(, 13): a(i, 3) = r.Offset(, 14)
End If

If (r.Value = "0620 TM, smagrisefoder" Or _
r.Value = "0621 TM, smagrisefoder") And _
r.Offset(, 2).Value = "DE1400 Holstebro" Then
l = l + 1: b(l, 1) = r.Offset(, 1)
b(l, 2) = r.Offset(, 13): b(l, 3) = r.Offset(, 14)
End If

If (r.Value = "0620 TM, smagrisefoder" Or _
r.Value = "0621 TM, smagrisefoder") And _
r.Offset(, 2).Value = "DE1200 Vesthimmerland" Then
v = v + 1: c(v, 1) = r.Offset(, 1)
c(v, 2) = r.Offset(, 13): c(v, 3) = r.Offset(, 14)
End If
Next
End With
With wbDest.Sheets("Ark1")
'.Cells.Clear
For i = LBound(a) To UBound(a)
.Cells(i, "a") = a(i, 1): .Cells(i, "b") = a(i, 2):
..Cells(i, "d") = a(i, 3)
Next
End With
Erase a
With wbDest.Sheets("Ark2")
'.Cells.Clear
For i = LBound(b) To UBound(b)
.Cells(i, "a") = b(i, 1): .Cells(i, "b") = b(i, 2):
..Cells(i, "d") = b(i, 3)
Next
End With
Erase b
With wbDest.Sheets("Ark3")
' .Cells.Clear
For i = LBound(c) To UBound(c)
.Cells(i, "a") = c(i, 1): .Cells(i, "b") = c(i, 2):
..Cells(i, "d") = c(i, 3)
Next
End With
Erase c
End Sub

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 78
Default Help with macro!

Thanks a lot!!!!!!

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
Macro recorded... tabs & file names changed, macro hangs Steve Excel Worksheet Functions 3 October 30th 09 11:41 AM
Macro Help Needed - Excel 2007 - Print Macro with Auto Sort Gavin Excel Worksheet Functions 0 May 17th 07 01:20 PM
how to count/sum by function/macro to get the number of record to do copy/paste in macro tango Excel Programming 1 October 15th 04 01:16 PM
macro to delete entire rows when column A is blank ...a quick macro vikram Excel Programming 4 May 3rd 04 08:45 PM
Start Macro / Stop Macro / Restart Macro Pete[_13_] Excel Programming 2 November 21st 03 05:04 PM


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

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

About Us

"It's about Microsoft Excel"