Sheetoffset

[sukitmw]

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(sheet 1) 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(Shee tsA and then B etc) that it is working on after the nested sub finishes pasting the data into sheet1?

Thanks ever so much!!!
linda

[MikeTheBike]

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(sheet 1) 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(Shee tsA 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

[sukitmw]

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:\P URCHASE.xls", FileFormat:=xlN ormal, _
' Password:="", WriteResPasswor d:="", ReadOnlyRecomme nded:=False, _
' CreateBackup:=F alse

'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") = "Descriptio n"
Range("I1") = "G/L Account"
Range("J1") = "Amount"
Range("A2") = "Example"
Range("A2").Cop y
Range("B2:J2"). PasteSpecial

Worksheets("DC" ).Select

'Dim SheetCount As Integer
'Dim NextSheet
'SheetCount = ActiveWorkbook. Sheets.Count
Workbooks("staf f claims.xls").Ac tivate
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(Ite m)


End If
Next

Next Item

End Sub

Sub PopPurchase(Ite m)
Dim iRow As Integer
Dim iSeq As Integer

'populating the purchase worksheet for PT entry


Worksheets("She et1").Select
Cells(1, 10).Select
ActiveCell.End( xlDown).Select
ActiveCell.offs et(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.offs et(0, -1).Select 'Expense Accts
ActiveCell.Form ulaR1C1 = _
"=VLOOKUP(R C[-1],'[claims-apc-test1.xls]ExpAccts'!Expen se,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

[MikeTheBike]

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

[sukitmw]

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(bas ed 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

[MikeTheBike]

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(R C[-1],'[claims-apc-test1.xls]ExpAccts'!Expen se,2,0)"

and

Workbooks("staf f claims.xls").Ac tivate
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

[sukitmw]

Thanks so much Mike...will test it out ......

Linda

[sukitmw]

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.FontSty le <> "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.Wor kbooks.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") = "Descriptio n"

Range("I1") = "G/L Account"

Range("J1") = "Amount"

Range("A2") = "Example"

Range("A2").Cop y

Range("B2:J2"). PasteSpecial

Cells(1, 10).Select

ActiveCell.End( xlDown).Select

iRow = ActiveCell.Row + 1




For Each Item In SourceBook.Work sheets

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.FontSty le <> "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:=xlAscen ding, Header:=xlYes, _
OrderCustom:=1, MatchCase:=Fals e, Orientation:=xl TopToBottom, _
DataOption1:=xl SortNormal



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.FontSty le <> "Bold" Then
NumDis = NumDis + 1
Else
NumDis = NumDis
End If



Next
End Function

[sukitmw]

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

[MikeTheBike]

Hi

First, the period in
If .Range("E" & x) <> 0 And .Range("E" & x).Font.FontSty le <> "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(Ite m) '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.FontSty le <> "Bold" Then

has become this

If .Range("E" & x) <> 0 And .Range("E" & x).Font.Bold = False Then


Does that make sense ??


MTB

[sukitmw]

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).FormulaR1 C1 = .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....s omething 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

[sukitmw]

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

[MikeTheBike]

Hi linda

Going back to you previouse post, modify this

Range("A" & iRow).Formula = .Range("B6") 'Name of Vendor/ID
Range("B" & iRow).FormulaR1 C1 = .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).FormulaR1 C1 = "=" & .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).FormulaR1 C1 = "=" & .Name & "!E1 & " &.Name & "!E2" 'Mobile


MTB

[sukitmw]

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

[MikeTheBike]

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