+ Reply to Thread
Results 1 to 3 of 3

Help with macro!

  1. #1
    Alen32
    Guest

    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. #2
    Seiya
    Guest

    Re: 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. #3
    Alen32
    Guest

    Re: Help with macro!

    Thanks a lot!!!!!!


+ 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