473,326 Members | 2,104 Online
Bytes | Software Development & Data Engineering Community
Post Job

Home Posts Topics Members FAQ

Join Bytes to post your question to a community of 473,326 software developers and data experts.

Sheetoffset

13
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
Aug 20 '07 #1
14 1920
MikeTheBike
639 Expert 512MB
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
Aug 20 '07 #2
sukitmw
13
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
Aug 21 '07 #3
MikeTheBike
639 Expert 512MB
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
Aug 21 '07 #4
sukitmw
13
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
Aug 22 '07 #5
MikeTheBike
639 Expert 512MB
Hi

Wether this is any easier to follow I don't, but I think so !

Expand|Select|Wrap|Line Numbers
  1. Sub proTest()
  2.     Dim SourceBook As Workbook
  3.     Dim Item As Worksheet
  4.     Dim iRow As Long
  5.     Dim x As Long
  6.  
  7.     Set SourceBook = ActiveWorkbook
  8.  
  9.     Application.Workbooks.Add
  10.  
  11.     'Populate the heading description
  12.     Range("A1") = "Vendor ID"
  13.     Range("B1") = "Invoice/CM #"
  14.     Range("C1") = "Date"
  15.     Range("D1") = "Date Due"
  16.     Range("E1") = "Accounts Payable Account"
  17.     Range("F1") = "Beginning Balance Transaction"
  18.     Range("G1") = "Number of Distributions"
  19.     Range("H1") = "Description"
  20.     Range("I1") = "G/L Account"
  21.     Range("J1") = "Amount"
  22.     Range("A2") = "Example"
  23.     Range("A2").Copy
  24.     Range("B2:J2").PasteSpecial
  25.     Cells(1, 10).Select
  26.     ActiveCell.End(xlDown).Select
  27.     iRow = ActiveCell.Row + 1
  28.  
  29. '    Workbooks("staff claims.xls").Activate
  30.     For Each Item In SourceBook.Worksheets
  31.         With Item
  32.             For x = 12 To 45 'up to last row b4 total
  33.                 If .Range("E" & x) <> 0 Then
  34.                     Range("J" & iRow) = .Range("E" & x) '$ Amt of Exp
  35.                     Range("H" & iRow) = .Range("A" & x) 'Description of expense
  36.                     Cells(iRow, 9) = "=VLOOKUP(RC[-1],'claims-apc-test1.xlsExpAccts'!Expense,2,0)"
  37.                     Range("A" & iRow) = .Range("B6") 'Name of Vendor/ID
  38.                     Range("B" & iRow) = .Range("B6") & "-" & .Range("F3") 'Invoice # (Name of Vendor AND Date)
  39.                     Range("C" & iRow) = .Range("F3") 'Date of Invoice
  40.                     Range("D" & iRow) = .Range("F3") + 30 'Due date of invoice 1 mth credit
  41.                     Range("E" & iRow) = "4010-000" 'Accts payable GL acct#
  42.                     Range("F" & iRow) = "False"  ' ??
  43. '                    Range("G" & iRow) = sNumDis ' ???  sNumDis NOT ASSIGNED
  44.                     Range("H" & iRow) = .Range("A" & x) 'Description
  45. '                    sGST = .Range("F53")  'sGST NOT USED ??
  46.                 End If
  47.             Next
  48.         End With
  49.         iRow = iRow + 1
  50.     Next Item
  51. End Sub
  52.  

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
Aug 22 '07 #6
sukitmw
13
Thanks so much Mike...will test it out ......

Linda
Aug 23 '07 #7
sukitmw
13
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
Aug 24 '07 #8
sukitmw
13
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
Aug 24 '07 #9
MikeTheBike
639 Expert 512MB
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

Expand|Select|Wrap|Line Numbers
  1. Function NumDisCount(ByRef ThisSheet As Worksheet) As Integer
  2.     Dim x As Long
  3.     NumDisCount = 0
  4.     With ThisSheet
  5.         For x = 12 To 50 'up to last row b4 total
  6.             If .Range("E" & x) <> 0 And .Range("E" & x).Font.Bold = False Then
  7.                 NumDisCount = NumDisCount + 1
  8.             End If
  9.         Next
  10.     End With
  11. 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
Aug 24 '07 #10
sukitmw
13
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
Aug 27 '07 #11
sukitmw
13
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
Aug 30 '07 #12
MikeTheBike
639 Expert 512MB
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')

Expand|Select|Wrap|Line Numbers
  1. With Item
  2.     Range("A" & iRow).Formula = "=" & .Name & "!B6" 'Name of Vendor/ID
  3.     Range("B" & iRow).FormulaR1C1 = "=" & .Name & "!E1 + " &.Name & "!E2" 'Mobile
  4.     Range("C" & iRow).Formula = "=" & .Name & "!E15" 'Work Related Transport
  5.     Range("D" & iRow).Formula = "=" & .Name & "!E16" 'Office to home/MRT transport
  6.     Range("E" & iRow).Formula = "=" & .Name & "!E19" 'Medical/Dental
  7. 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
Aug 31 '07 #13
sukitmw
13
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
Sep 17 '07 #14
MikeTheBike
639 Expert 512MB
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
Sep 18 '07 #15

Sign in to post your reply or Sign up for a free account.

Similar topics

6
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...
0
isladogs
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...
1
isladogs
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...
0
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...
0
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...
1
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)...
1
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...
1
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....
0
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
0
isladogs
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...

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.