Hi,
I'm trying to do a series of data extraction from all the sheets(Sheets A to Z) in a workbook and put the results into the first worksheet(sheet1) of this workbook.
I've nested a sub within a sub. The first sub does all the extraction and the nested sub does the pasting into various cells in the first sheet(Sheet1).
How do I pass the macro back to the worksheets(SheetsA and then B etc) that it is working on after the nested sub finishes pasting the data into sheet1?
Thanks ever so much!!!
linda
14 1920
Hi,
I'm trying to do a series of data extraction from all the sheets(Sheets A to Z) in a workbook and put the results into the first worksheet(sheet1) of this workbook.
I've nested a sub within a sub. The first sub does all the extraction and the nested sub does the pasting into various cells in the first sheet(Sheet1).
How do I pass the macro back to the worksheets(SheetsA and then B etc) that it is working on after the nested sub finishes pasting the data into sheet1?
Thanks ever so much!!!
linda
Hi
I think we need to see some of your code before any reasonable statement can be made, otherwise I could be asking questions most of the day !?
MTB
Hi Mike,
Thanks for responding....
Below is my entire prog...
As u can see, I'm trying to extract data based on some criterion from all the sheets in the workbook and then put them in another worksheet. When I pass the macro from the sub protest to sub PopPurchase and this sub finishes, it's not looking at the correct active worksheet. I need it to look at Sheet(DC) that I was working on and then when that worksheet is done to go to the next worksheet in the workbook and so on.
HELP!!!!!...I'm really a beginner at this and all the books I've read doesn't seem to give enough examples...
I tried to get someone to do this but he's migrated and wants to charge twice as much and my little biz can't afford him anymore....
thanks so much!!!!
linda
Option Explicit
Dim sCellID As String
Dim cCellID As String
Dim x As Integer
Dim y As Integer
Dim Z As Integer
Dim i As Integer
Dim CustName As String
Dim sAmt As String
Dim sExpense As String
Dim sItems As String
Dim sVendorID As String
Dim sDate As Date
Dim sBeginning As String
Dim sDesc As String
Dim sNumDis As Integer
Dim sGLAcct As String
Dim Vendor As String
Dim Expense As String
Dim sExpName As String
Dim sCount As Integer
Dim ExpRange() As String
Dim ColCount As Integer
Dim CountIf() As Variant
Dim sGST As String
Sub proTest()
'Add a worksheet
Dim WS As Worksheet
Set WS = Sheets.Add
'Add a workbook for purchase inpu
''Workbooks.Add
' ActiveWorkbook.SaveAs Filename:="C:\PURCHASE.xls", FileFormat:=xlNormal, _
' Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
' CreateBackup:=False
'Populate the heading description
Range("A1") = "Vendor ID"
Range("B1") = "Invoice/CM #"
Range("C1") = "Date"
Range("D1") = "Date Due"
Range("E1") = "Accounts Payable Account"
Range("F1") = "Beginning Balance Transaction"
Range("G1") = "Number of Distributions"
Range("H1") = "Description"
Range("I1") = "G/L Account"
Range("J1") = "Amount"
Range("A2") = "Example"
Range("A2").Copy
Range("B2:J2").PasteSpecial
Worksheets("DC").Select
'Dim SheetCount As Integer
'Dim NextSheet
'SheetCount = ActiveWorkbook.Sheets.Count
Workbooks("staff claims.xls").Activate
Dim Item As Worksheet
For Each Item In ActiveWorkbook.Worksheets
' For i = 1 To SheetCount
For x = 12 To 45 'up to last row b4 total
sCellID = "E" + CStr(x)
If Range(sCellID) > 0 Or Range(sCellID) < 0 Then
sAmt = Range(sCellID)
sCellID = "A" + CStr(x) 'Description of expense
sDesc = Range(sCellID)
sCellID = "B6" 'Name of Vendor
sVendorID = Range(sCellID)
sCellID = "F53" 'Gst amt
sGST = Range(sCellID)
sCellID = "F3" 'Date
sDate = Range(sCellID)
Call PopPurchase(Item)
End If
Next
Next Item
End Sub
Sub PopPurchase(Item)
Dim iRow As Integer
Dim iSeq As Integer
'populating the purchase worksheet for PT entry
Worksheets("Sheet1").Select
Cells(1, 10).Select
ActiveCell.End(xlDown).Select
ActiveCell.offset(1, 0).Select
iRow = ActiveCell.Row
iSeq = 1
'populating the worksheet
cCellID = "J" + CStr(iRow) '$ Amt of Exp
Range(cCellID) = sAmt
cCellID = "H" + CStr(iRow) 'Description
Range(cCellID) = sDesc
ActiveCell.offset(0, -1).Select 'Expense Accts
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[claims-apc-test1.xls]ExpAccts'!Expense,2,0)"
cCellID = "A" + CStr(iRow) 'Vendor ID
Range(cCellID) = sVendorID
cCellID = "B" + CStr(iRow) 'Invoice #
Range(cCellID) = (sVendorID & "-" & sDate)
cCellID = "C" + CStr(iRow) 'Date of Invoice
Range(cCellID) = sDate
cCellID = "D" + CStr(iRow) 'Due date of invoice 1 mth credit
Range(cCellID) = sDate + 30
cCellID = "E" + CStr(iRow) 'Accts payable GL acct#
Range(cCellID) = "4010-000"
cCellID = "F" + CStr(iRow) 'Hard coded
Range(cCellID) = "FALSE"
cCellID = "G" + CStr(iRow) 'Number of rows for this employee's claim
Range(cCellID) = sNumDis
cCellID = "H" + CStr(iRow) 'Description
Range(cCellID) = sDesc
SHEETOFFSET = Worksheets(-i, 0).Select (THIS DOESN"T WORK)
End Sub
Hi
It is all a little confusing, and I'm sure there is a simpler way, but three questions first.
What do you do with the worksheet you add and write the headings in?
Is "staff claims.xls" workbook already open, or is it the workbook containing this code?
and last but not least what are you trying to do with the statement
SHEETOFFSET = Worksheets(-i, 0).Select ?
MTB
Hi Mike,
The staff claims worksheet is open and the macro is also in this workbook.
I'm sure there is a simpler way if only I know how....
I'm trying to extract some information(based on the condition that the amt in Col E is <> 0) from each sheet in the staff claims workbook and then write these information to a new sheet in the same workbook(or another wkbook if easier).
I've set up a separate sub to write all the info to the added worksheet but when it is done, I need to pass the macro back to the original sheet to continue with the next row that is <>0. I can't seem to do that and thought SHEETOFFSET will do the job.
My looping of each worksheet in the workbook also doesn't seem to work. It just loops though 16 time(# of worksheets) on the same sheet....
Thanks for any tips you have.....I've searched the web for routines to extract data (based on condition) fm a set of worksheets to write into a different worksheet but can't seem to find any....do u know any?
Cheers,
linda
Hi
Wether this is any easier to follow I don't, but I think so ! - Sub proTest()
-
Dim SourceBook As Workbook
-
Dim Item As Worksheet
-
Dim iRow As Long
-
Dim x As Long
-
-
Set SourceBook = ActiveWorkbook
-
-
Application.Workbooks.Add
-
-
'Populate the heading description
-
Range("A1") = "Vendor ID"
-
Range("B1") = "Invoice/CM #"
-
Range("C1") = "Date"
-
Range("D1") = "Date Due"
-
Range("E1") = "Accounts Payable Account"
-
Range("F1") = "Beginning Balance Transaction"
-
Range("G1") = "Number of Distributions"
-
Range("H1") = "Description"
-
Range("I1") = "G/L Account"
-
Range("J1") = "Amount"
-
Range("A2") = "Example"
-
Range("A2").Copy
-
Range("B2:J2").PasteSpecial
-
Cells(1, 10).Select
-
ActiveCell.End(xlDown).Select
-
iRow = ActiveCell.Row + 1
-
-
' Workbooks("staff claims.xls").Activate
-
For Each Item In SourceBook.Worksheets
-
With Item
-
For x = 12 To 45 'up to last row b4 total
-
If .Range("E" & x) <> 0 Then
-
Range("J" & iRow) = .Range("E" & x) '$ Amt of Exp
-
Range("H" & iRow) = .Range("A" & x) 'Description of expense
-
Cells(iRow, 9) = "=VLOOKUP(RC[-1],'claims-apc-test1.xlsExpAccts'!Expense,2,0)"
-
Range("A" & iRow) = .Range("B6") 'Name of Vendor/ID
-
Range("B" & iRow) = .Range("B6") & "-" & .Range("F3") 'Invoice # (Name of Vendor AND Date)
-
Range("C" & iRow) = .Range("F3") 'Date of Invoice
-
Range("D" & iRow) = .Range("F3") + 30 'Due date of invoice 1 mth credit
-
Range("E" & iRow) = "4010-000" 'Accts payable GL acct#
-
Range("F" & iRow) = "False" ' ??
-
' Range("G" & iRow) = sNumDis ' ??? sNumDis NOT ASSIGNED
-
Range("H" & iRow) = .Range("A" & x) 'Description
-
' sGST = .Range("F53") 'sGST NOT USED ??
-
End If
-
Next
-
End With
-
iRow = iRow + 1
-
Next Item
-
End Sub
-
This code sets a reference to the workbook running the code (the SourceBook), opens a new book (you said this was OK!), which is then the active book/sheet and is therefore the default Workbook/Worksheet and does not need a reference.
It then cycles through the sheets in the "source" book's sheets copying those to the new book/sheet, and stays there when it finishes.
I may have misinterpreted some of the code, but you can fix that I am sure.
You will note you do not have to activate a sheet to access its information.
The only problem I have is the references in the code to two other book ie.
Cells(iRow, 9) = "=VLOOKUP(RC[-1],'[claims-apc-test1.xls]ExpAccts'!Expense,2,0)"
and
Workbooks("staff claims.xls").Activate
why activate this, or is this the book containing the code ??
These may or may not be a problem, but without knowing what where these files are I cannot be certain, but I think that is the case whatever you do.
Does that help/make sense?
MTB
Thanks so much Mike...will test it out ......
Linda
Hi Mike,
Your program works great....Thanks again so v much!!!!
I had to make 1 adjustment bringing iRow=iRow+1 up a row.
The NumDis is actually the number of rows that has an amt in it that is <>0.
I tried to do a side FUNCTION to calculate. However it doens't seem to be looking at the sheets in the Source workbook. Instead it processes the function on the worksheet that was added.
Any clue???
I'm also curious on why there is a period in front of the Range but when I tried to do that in the Function, it comes up with error.
If .Range("E" & x) <> 0 And .Range("E" & x).Font.FontStyle <> "Bold" Then
I've included my revised code below...
Thanks again so v much Mike......for all your time, patience and brainwork!!!!
Linda
Option Explicit
Dim NumDis As Integer
Sub proTest()
Dim SourceBook As Workbook
Dim Item As Worksheet
Dim iRow As Long
Dim x As Long
Set SourceBook = ActiveWorkbook
Application.Workbooks.Add
'Populate the heading description
Range("A1") = "Vendor ID"
Range("B1") = "Invoice/CM #"
Range("C1") = "Date"
Range("D1") = "Date Due"
Range("E1") = "Accounts Payable Account"
Range("F1") = "Beginning Balance Transaction"
Range("G1") = "Number of Distributions"
Range("H1") = "Description"
Range("I1") = "G/L Account"
Range("J1") = "Amount"
Range("A2") = "Example"
Range("A2").Copy
Range("B2:J2").PasteSpecial
Cells(1, 10).Select
ActiveCell.End(xlDown).Select
iRow = ActiveCell.Row + 1
For Each Item In SourceBook.Worksheets
With Item
' NumDis = 0
For x = 12 To 50 'up to last row b4 total
If .Range("E" & x) <> 0 And .Range("E" & x).Font.FontStyle <> "Bold" Then
Range("J" & iRow) = .Range("E" & x) '$ Amt of Exp
Range("H" & iRow) = .Range("A" & x) 'Description of expense
Range("I" & iRow) = .Range("I" & x) 'G/L Acct Number
Range("A" & iRow) = .Range("B6") 'Name of Vendor/ID
Range("B" & iRow) = .Range("B6") & "-" & .Range("F3") 'Invoice # (Name of Vendor AND Date)
Range("C" & iRow) = .Range("F3") 'Date of Invoice
Range("D" & iRow) = .Range("F3") + 30 'Due date of invoice 1 mth credit
Range("E" & iRow) = "4010-000" 'Accts payable GL acct#
Range("F" & iRow) = "False" ' hardcoded code
Range("G" & iRow) = NumDis 'calc from Function NumDisCount
Range("H" & iRow) = .Range("A" & x) 'Description
End If
iRow = iRow + 1
Next
End With
Next Item
'Delete the Example Row
Rows(2).Delete
'Sort the sheet to get rid of empty rows
Range("A1:J1000").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Function NumDisCount()
Dim SourceBook As Workbook
Dim Item As Worksheet
Dim iRow As Long
Dim x As Long
NumDis = 0
For x = 12 To 50 'up to last row b4 total
If Range("E" & x) <> 0 And Range("E" & x).Font.FontStyle <> "Bold" Then
NumDis = NumDis + 1
Else
NumDis = NumDis
End If
Next
End Function
Sorry Mike,
I wasn't clear on the NumDis...it's actually a constant # obtained by counting the # of rows <>0 in each worksheet and needs to be put into each row tht on the added sheet.
Thanks again....
linda
Hi
First, the period in
If .Range("E" & x) <> 0 And .Range("E" & x).Font.FontStyle <> "Bold" Then
means the .Range("E" & x) range object is refered to that range in the sheet specified using the With construct
ie
With Item
SomeVariable = .Range("E" & x)
End With
is equivalant to
SomeVariable = Item.Range("E" & x)
See ?
Threfore, you need to pass the sheet object variable to the Function so - Function NumDisCount(ByRef ThisSheet As Worksheet) As Integer
-
Dim x As Long
-
NumDisCount = 0
-
With ThisSheet
-
For x = 12 To 50 'up to last row b4 total
-
If .Range("E" & x) <> 0 And .Range("E" & x).Font.Bold = False Then
-
NumDisCount = NumDisCount + 1
-
End If
-
Next
-
End With
-
End Function
And calling it so
Range("G" & iRow) = NumDisCount(Item) 'calc from NumDisCount
Please not I have moded the function into a "proper" integer function, returning the integer value direct and not using the module level variable NumDis
Also not that this
If .Range("E" & x) <> 0 And .Range("E" & x).Font.FontStyle <> "Bold" Then
has become this
If .Range("E" & x) <> 0 And .Range("E" & x).Font.Bold = False Then
Does that make sense ??
MTB
Thank you so much Mike.....
I think I understand but need to try it out step by step...me kinda slow....
If I wanted to do the same as my original macro ie. taking info from each item in a worksheet and then instead of puting the value into the new workbook, I want to link it as formula. How wld I code that?
I tried below but doesn't work. It still just puts in the value and not the link to the cell in the source workbook.
ange("A" & iRow).Formula = .Range("B6") 'Name of Vendor/ID
Range("B" & iRow).FormulaR1C1 = .Range("E1") + .Range("E2") 'Mobile
Range("C" & iRow).Formula = .Range("E15") 'Work Related Transport
Range("D" & iRow).Formula = .Range("E16") 'Office to home/MRT transport
Range("E" & iRow).Formula = .Range("E19") 'Medical/Dental
Thanks again so much Mike.....if this is getting to much for you, it's alright....I understand....something keeps cropping up as I do these macros....I don't do them all the time but lately, so many requirements to change rpts.
I also have this mini sub routine that seems to only delete every other row that has 0 value instead of all rows in col AA with 0 value
Sub DeleteYTD0Rows()
Dim r As Long
For r = 6 To 242 Step 1
If Range("AA" & r) = 0 Then
Rows(r).Delete
End If
Next
Thanks again and again......
Linda
Hi Mike,
Just wanted to let you know that your solution works like a dream!!!
Thanks much and I've also figured out how to delete those rows with zeros for my other macro.....
Just one more question if you find the time....
How do I do I link certain cells from each of these workbooks to another summary sheet?
Thanks again!!!!
linda
Hi linda
Going back to you previouse post, modify this
Range("A" & iRow).Formula = .Range("B6") 'Name of Vendor/ID
Range("B" & iRow).FormulaR1C1 = .Range("E1") + .Range("E2") 'Mobile
Range("C" & iRow).Formula = .Range("E15") 'Work Related Transport
Range("D" & iRow).Formula = .Range("E16") 'Office to home/MRT transport
Range("E" & iRow).Formula = .Range("E19") 'Medical/Dental
to this (using earlier code/sheet object 'Item') - With Item
-
Range("A" & iRow).Formula = "=" & .Name & "!B6" 'Name of Vendor/ID
-
Range("B" & iRow).FormulaR1C1 = "=" & .Name & "!E1 + " &.Name & "!E2" 'Mobile
-
Range("C" & iRow).Formula = "=" & .Name & "!E15" 'Work Related Transport
-
Range("D" & iRow).Formula = "=" & .Name & "!E16" 'Office to home/MRT transport
-
Range("E" & iRow).Formula = "=" & .Name & "!E19" 'Medical/Dental
-
End with
??
Note: this
Range("B" & iRow).FormulaR1C1 = "=" & .Name & "!E1 + " &.Name & "!E2" 'Mobile
will add (total) the two numbers, if it is two parts of a phone number then try this which concatenates them
Range("B" & iRow).FormulaR1C1 = "=" & .Name & "!E1 & " &.Name & "!E2" 'Mobile
MTB
Thank you so v much Mike.....
I was so v busy with some other firedrills so didn't have time to finish off....
I think I'm done for this round....with your help!
Thx again...ever so much!!!!
linda
Thank you so v much Mike.....
I was so v busy with some other firedrills so didn't have time to finish off....
I think I'm done for this round....with your help!
Thx again...ever so much!!!!
linda
You are very welcome, I'm just happy it all works.
Thanks for letting us know
MTB
Sign in to post your reply or Sign up for a free account.
Similar topics
by: DancesInGarden |
last post by:
Using Microsoft Office 2003.
From Access, triggered by a button click on a form, I have a piece of code that opens Excel, opens a specific file, activates a specific sheet in that workbook, prints...
|
by: isladogs |
last post by:
The next Access Europe meeting will be on Wednesday 6 Mar 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM).
In this month's session, we are pleased to welcome back...
|
by: isladogs |
last post by:
The next Access Europe meeting will be on Wednesday 6 Mar 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM).
In this month's session, we are pleased to welcome back...
|
by: jfyes |
last post by:
As a hardware engineer, after seeing that CEIWEI recently released a new tool for Modbus RTU Over TCP/UDP filtering and monitoring, I actively went to its official website to take a look. It turned...
|
by: ArrayDB |
last post by:
The error message I've encountered is; ERROR:root:Error generating model response: exception: access violation writing 0x0000000000005140, which seems to be indicative of an access violation...
|
by: PapaRatzi |
last post by:
Hello,
I am teaching myself MS Access forms design and Visual Basic. I've created a table to capture a list of Top 30 singles and forms to capture new entries. The final step is a form (unbound)...
|
by: CloudSolutions |
last post by:
Introduction:
For many beginners and individual users, requiring a credit card and email registration may pose a barrier when starting to use cloud servers. However, some cloud server providers now...
|
by: Shællîpôpï 09 |
last post by:
If u are using a keypad phone, how do u turn on JavaScript, to access features like WhatsApp, Facebook, Instagram....
|
by: af34tf |
last post by:
Hi Guys, I have a domain whose name is BytesLimited.com, and I want to sell it. Does anyone know about platforms that allow me to list my domain in auction for free. Thank you
|
by: isladogs |
last post by:
The next Access Europe User Group meeting will be on Wednesday 3 Apr 2024 starting at 18:00 UK time (6PM UTC+1) and finishing by 19:30 (7.30PM).
In this session, we are pleased to welcome former...
| |