Solved: Macros across workbboks

[Anomandaris]

Hi guys, I have this code, the macro is in a workbook called Book3 with some data in Sheet2, I need the macro to use that data to give a certain output in another Workbook("Aro") in a sheet called "Roll"

This is the code I have, it gives me an error mesg saying subscript is out of range, how do i adjust it?
Thanks

[VBA]
Dim LR1 As Long, a As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim c As Range, firstaddress As String
Application.ScreenUpdating = False
Set ws1 = Workbooks("Aro").Sheets("Roll")
Set ws2 = Workbooks("Book3").Sheets("Sheet2")
With ws1
LR1 = .Cells(Rows.Count, 2).End(xlUp).Row
For a = 2 To LR1 Step 1
With ws2.Columns(1)
Set c = .Find(ws1.Cells(a, 2).Value, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstaddress = c.Address
Do
ws1.Cells(a, 2) = c.Offset(, 1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
Next a
End With
Application.ScreenUpdating = True
[/VBA]

[JONvdHeyden]

Perhaps you can avoid a loop and use a Vlookup. Something like this perhaps:

[VBA]Sub GetData()
Dim wsSrc As Worksheet
Dim wsDest As Worksheet
Dim lngLastRow As Long
Dim rngDest As Range
Set wsSrc = Workbooks("Book3.xls").Sheets("Sheet2")
Set wsDest = Workbooks("Aro.xls").Sheets("Roll")
lngLastRow = wsDest.Cells(Rows.Count, 2).End(xlUp).Row
Set rngDest = wsDest.Range("B2:B" & lngLastRow)
rngDest = Application.VLookup(rngDest, wsSrc.Range("A:B"), 2, 0)
End Sub[/VBA]

[Bob Phillips]

That suggests one of the books/sheets doesn't exist, but we would need a workbook example to track it down.

[JONvdHeyden]

I had the same error in my example but adding the '.xls' to the book name seemed to make it work.

[Anomandaris]

Hi Jon,

thanks that works, but problem is when I add the code into a larger code it doesnt work

you're right xld, i throw in some wkbks so you can see what im trying to do
I'll open a new thread and add attachments ---i cant seem to add it here

[JONvdHeyden]

Hi Jon,

thanks that works, but problem is when I add the code into a larger code it doesnt work

In what way won't it work? It's bound to be more efficient (and simpler) than the loop method that you are currently using...

[Anomandaris]

I oprened a new thread to add an attachment - (Xld and JonHayden you are familiar with some of this code)

Ok this is what the overall code looks like
[VBA]
Sub Ty()

Dim Filename As Variant
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim strDate As String
strDate = Format(Date, "dd-mm-yy") & "." & Format(Time, "hh-mm-ss")


Filename = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If Filename <> False Then

Set wbSource = Workbooks.Open(Filename)
wbSource.Worksheets("Roll").Copy
Set wbTarget = ActiveWorkbook

'your code
Dim i As Long
Dim rng As Range

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With



With Worksheets("Roll")

i = 2
Do

If .Cells(i, "A").Value = "" Or ( _
.Cells(i, "F").Value = "" And .Cells(i, "G").Value = "") Then

If rng Is Nothing Then

Set rng = .Rows(i)
Else

Set rng = Union(rng, .Rows(i))
End If
End If

.Cells(i, "C").Value = .Cells(i, "F").Value + .Cells(i, "G").Value
.Cells(i, "A").Value = IIf(.Cells(i, "C").Value < 0, "out", "in")
.Cells(i, "C").Value = Abs(.Cells(i, "C").Value)
If .Cells(i, "F").Value Then .Cells(i, "H").Value = 100
If .Cells(i, "G").Value Then .Cells(i, "H").Value = 200
.Cells(i, "D").Resize(, 4).Value = Array("colour", "annual", "", "")
i = i + 1
Loop Until .Cells(i, "A").Value = "ACTION"

If rng Is Nothing Then

Set rng = .Rows(i)
Else

Set rng = Union(rng, .Rows(i))
End If

rng.Delete

.Range("A1:H1").Value = Array("Cashflow", "ID", "Qty", "Category", "Duration", "", "", "File#")
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With


Dim wsSrc As Worksheet
Dim wsDest As Worksheet
Dim lngLastRow As Long
Dim rngDest As Range
Set wsSrc = Workbooks("Book3.xls").Sheets("Sheet2")
Set wsDest = Workbooks("Aro.xls").Sheets("Roll")
lngLastRow = wsDest.Cells(Rows.Count, 2).End(xlUp).Row
Set rngDest = wsDest.Range("B2:B" & lngLastRow)
rngDest = Application.VLookup(rngDest, wsSrc.Range("A:B"), 2, 0)

wbTarget.SaveAs "Aro1" & "" & strDate & ".xls"

wbTarget.Close
wbSource.Close SaveChanges:=False
MsgBox "The OMS import file was saved in:" & "Aro1.xls" & "" & strDate

End If
End Sub


[/VBA]

So basically Book 3 has the macro with a button on sheet 1. On Sheet 2 there is a mapping guide that changes ID value.
The macro first opens dialog box, we select Wkbook called "Aro", on Aro there is a Worksheet "Roll"...macro copies this sheet into a new Workbook and then rearranges the data and saves the file as "Aro1" . Here Column B values "ID" needs to be changed according to the guide in Book3 "Sheet2", but this part isnt working.


so here are the files----i just realized i can only upload only 1 workbook.......so what I'm doing is throwing in all the sheets in one workbook,
Sheet 1 and sheet2 are for Wkbk "Book3", Sheet 3 is "Roll" from Wkbook "Aro", and Sheet 4 is the final solution that is saved in a new Workbook "Aro1".



thanks

[Anomandaris]

Hey Jon,

it works when by itself but when I put it into a larger code it doesnt work.....neither does my loop code...i think it may have something to do with the 'Dim Workbook' part as there's a few of those

here check it out

[VBA]
Sub Ty()

Dim Filename As Variant
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim strDate As String
strDate = Format(Date, "dd-mm-yy") & "." & Format(Time, "hh-mm-ss")


Filename = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If Filename <> False Then

Set wbSource = Workbooks.Open(Filename)
wbSource.Worksheets("Roll").Copy
Set wbTarget = ActiveWorkbook

'your code
Dim i As Long
Dim rng As Range

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With



With Worksheets("Roll")

i = 2
Do

If .Cells(i, "A").Value = "" Or ( _
.Cells(i, "F").Value = "" And .Cells(i, "G").Value = "") Then

If rng Is Nothing Then

Set rng = .Rows(i)
Else

Set rng = Union(rng, .Rows(i))
End If
End If

.Cells(i, "C").Value = .Cells(i, "F").Value + .Cells(i, "G").Value
.Cells(i, "A").Value = IIf(.Cells(i, "C").Value < 0, "out", "in")
.Cells(i, "C").Value = Abs(.Cells(i, "C").Value)
If .Cells(i, "F").Value Then .Cells(i, "H").Value = 100
If .Cells(i, "G").Value Then .Cells(i, "H").Value = 200
.Cells(i, "D").Resize(, 4).Value = Array("colour", "annual", "", "")
i = i + 1
Loop Until .Cells(i, "A").Value = "ACTION"

If rng Is Nothing Then

Set rng = .Rows(i)
Else

Set rng = Union(rng, .Rows(i))
End If

rng.Delete

.Range("A1:H1").Value = Array("Cashflow", "ID", "Qty", "Category", "Duration", "", "", "File#")
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With


Dim wsSrc As Worksheet
Dim wsDest As Worksheet
Dim lngLastRow As Long
Dim rngDest As Range
Set wsSrc = Workbooks("Book3.xls").Sheets("Sheet2")
Set wsDest = Workbooks("Aro.xls").Sheets("Roll")
lngLastRow = wsDest.Cells(Rows.Count, 2).End(xlUp).Row
Set rngDest = wsDest.Range("B2:B" & lngLastRow)
rngDest = Application.VLookup(rngDest, wsSrc.Range("A:B"), 2, 0)

wbTarget.SaveAs "Aro1" & "" & strDate & ".xls"

wbTarget.Close
wbSource.Close SaveChanges:=False
MsgBox "The OMS import file was saved in:" & "Aro1.xls" & "" & strDate

End If
End Sub

[/VBA]

[lucas]

Threads merged

[Anomandaris]

thanks lucas

[Anomandaris]

any idea guys how i should change it?
i'm thinking it has to be the workbook and worksheet variables, maybe there's too many Dim functions referring to them

thanks

[Anomandaris]

sorry if im annoying you guys, but please can anyone point out where the mistake is.....Xld i need you dude, come to my rescue yet again...

[Anomandaris]

Ah I figured it out --- instead of wsDest I just needed to have Sheets("Roll")

thanks guys