Offset (start after last row of previous procedure)-Merging macros

M

Mslady

I am tryng to merge two macros here:
I have two macros
Each macro imports data from a text file, formats them appropriately
(extracting data based on criteria) and placing them in designated
columns in Sheet1

The macro do absolutely the same thing, except the format of each
(placement of data in each cell) in the text file is a little
different.
one macro (AggregateMetrics: ExtractDataX_Click) works with data prior
to 3/2/05
the other (SummaryMetrics: ExtractDataY_Click) works with data prior
after 3/2/05.
Reads text file and extracts specific data based on criteria.
They both work perfectly.

Except i am trying to merge the macro (instead of two) with IF
statements to work based on criteria with just one text file that
contains all the data.
If date is >= 3/2/05...extract this from cells and place here
else
extract this from cells and place here

Or perhaps If InStr(cell, "AGGREGATION METRICS:") > 0 Then ....
and If InStr(cell, "SUMMARY METRICS:") > 0 Then

Whichever is wiser!!


I have attachd what i have so far and it's doesn't pick up the correct
data, even thouh they both work perfectly independently. But tryng to
combine things here with an IF statement is such a nightmare, and i
have spent so muchtime on this already and i am getting no where.


SO HERE IS WHAT I HAVE RESULTED TO: (correct me if this is a bad idea,
I am open to suggestions please :) )

I have a procedure where i call the two procedures
[ExtractDataX_Click() and ExtractDataY_Click()] to extract data with
each criteria, one after the other (see purple colored code).

However there is one problem with my offset(...)
I need the other procedure to pick up on the row where the other the
other data left off. instead of overiding the data from the previous
one.
I am having trouble with the offset, i have shown the line in red

Here's my code (excel also attached):

Code:
--------------------
Private Sub wkscmd_ExtractData_Click()
*Call ExtractDataX_Click
Call ExtractDataY_Click *

Sheets("Sheet1").Select
Sheets("Sheet1").Copy
Application.DisplayAlerts = False
ActiveSheet.Name = "DailyReportData"
ActiveWorkbook.SaveAs ThisWorkbook.PATH & "\Summary&AggregateMetrics-To-Date" '& Format(Date, "mmmyy")
Application.DisplayAlerts = True

Windows("DailyRpt-Import&ExtractMacro.xls").Activate 'Go back to rawdata workbook
ActiveWorkbook.Close SaveChanges:=False
End Sub


Private Sub ExtractDataX_Click()
' Local Variables
Dim cell As Range, rngOut As Range
Dim strDate As String, strTable As String
Dim strPreAGG As String, strPostAGG As String, strCompression As String
Dim strRenovated As String, strRenopercent As String

' Read data
For Each cell In Me.Range("rdi_TableTop", "A" & Me.Range("A65536").End(xlUp).Row)
If ActiveSheet.Name = Me.Name Then cell.Select

' Get effective date
If InStr(cell, "SUMMARY METRICS:") > 0 Then
If strDate = "" Or strDate <> Right(cell, 10) Then strDate = Right(cell, 10)
strDate = Format(strDate, "mm/dd/yyyy")
End If

' Get Global House Count:
If InStr(cell, "GLOBAL HOUSE COUNT:") > 0 Then
'If strPreAGG = "" Or strPreAGG <> Trim(Mid(cell, 22, 13)) Then
strPreAGG = Trim(Mid(cell, 22, 13))
strPostAGG = Trim(Mid(cell, 59, 11))
strCompression = Trim(Right(cell, 4))
strRenovated = Trim(Mid(cell, 38, 12))
strRenopercent = Trim(Mid(cell, 53, 4))
If InStr(cell, "TOTAL") = 0 Then
cell.Select
If IsNumeric(strPreAGG) And IsNumeric(strPostAGG) Then
Set rngOut = Worksheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0)
rngOut.Offset(0, 0) = strDate
rngOut.Offset(0, 1) = strPreAGG
rngOut.Offset(0, 2) = strPostAGG
rngOut.Offset(0, 3) = strCompression
rngOut.Offset(0, 4) = strRenovated
rngOut.Offset(0, 5) = strRenopercent
End If
End If
End If
Next cell
End Sub

Private Sub ExtractDataY_Click()
' Local Variables
Dim cell As Range, rngOut As Range
Dim strDate As String, strTable As String
Dim strPreAGG As String, strPostAGG As String, strCompression As String
Dim strRenovated As String, strRenopercent As String

' Read data
For Each cell In Me.Range("rdi_TableTop", "A" & Me.Range("A65536").End(xlUp).Row)
If ActiveSheet.Name = Me.Name Then cell.Select

' Get effective date
If InStr(cell, "AGGREGATION METRICS:") > 0 Then
If strDate = "" Or strDate <> Right(cell, 10) Then strDate = Right(cell, 10)
strDate = Format(strDate, "mm/dd/yyyy")
End If

' Get Global House Count:
If InStr(cell, "GLOBAL HOUSE COUNT:") > 0 Then
'If strPreAGG = "" Or strPreAGG <> Trim(Mid(cell, 22, 13)) Then
strPreAGG = Trim(Mid(cell, 24, 13))
strPostAGG = Trim(Mid(cell, 41, 16))
strCompression = Trim(Right(cell, 4))
If InStr(cell, "TOTAL") = 0 Then
cell.Select
If IsNumeric(strPreAGG) And IsNumeric(strPostAGG) Then
*Set rngOut = Worksheets("Sheet1").Range("A65536").End(xlUp).Offset(0, -ActiveCell.Column + 1) *
rngOut.Offset(0, 0) = strDate
rngOut.Offset(0, 1) = strPreAGG
rngOut.Offset(0, 2) = strPostAGG
rngOut.Offset(0, 3) = strCompression
End If
End If
End If
Next cell
End Sub
--------------------


Thanks for taking the time to read my post.
Please feel free to give me suggestions, ideas, anything.


+-------------------------------------------------------------------+
|Filename: ExtractData.ZIP |
|Download: http://www.excelforum.com/attachment.php?postid=3931 |
+-------------------------------------------------------------------+
 
M

Mslady

I have attached the sheet with my macro (zip file above)

Macro is located in sheet2.
I have imported the textfile inside the sheet.
You may Click on the second button to run the code.

Thank you.
 
P

Patrick Molloy

The news group viewer that I use does not allow attachments, and I'd be
surprised if anyone opened an attachment that could run live code.
Usually better to display the offending code with as much description as
possible.

Sub GetValue(Thisdate as date)

IF ThisDate >Cdate("3-feb-2005") Then
ExtractDataY_Click
else
ExtractDataX_Click
end if

End Sub
 
M

Mslady

Thanks patrick for taking the time to look.
I attached the file just in case someone is able to download.

I also pasted the code in my initial post: and i highlighted in red,
where my problem is: I tried that you gave me, it doesn't work, because
data from ExtractDataY overrides ExtractDataX :( . And i think the
problem lies in my *offset*. I have highlight it in red in my code.
Please take a look. Anybody..pleae :)


Code:
--------------------
Private Sub wkscmd_ExtractData_Click()
*Call ExtractDataX_Click
Call ExtractDataY_Click *

Sheets("Sheet1").Select
Sheets("Sheet1").Copy
Application.DisplayAlerts = False
ActiveSheet.Name = "DailyReportData"
ActiveWorkbook.SaveAs ThisWorkbook.PATH & "\Summary&AggregateMetrics-To-Date" '& Format(Date, "mmmyy")
Application.DisplayAlerts = True

Windows("DailyRpt-Import&ExtractMacro.xls").Activate 'Go back to rawdata workbook
ActiveWorkbook.Close SaveChanges:=False
End Sub


Private Sub ExtractDataX_Click()
' Local Variables
Dim cell As Range, rngOut As Range
Dim strDate As String, strTable As String
Dim strPreAGG As String, strPostAGG As String, strCompression As String
Dim strRenovated As String, strRenopercent As String

' Read data
For Each cell In Me.Range("rdi_TableTop", "A" & Me.Range("A65536").End(xlUp).Row)
If ActiveSheet.Name = Me.Name Then cell.Select

' Get effective date
If InStr(cell, "SUMMARY METRICS:") > 0 Then
If strDate = "" Or strDate <> Right(cell, 10) Then strDate = Right(cell, 10)
strDate = Format(strDate, "mm/dd/yyyy")
End If

' Get Global House Count:
If InStr(cell, "GLOBAL HOUSE COUNT:") > 0 Then
'If strPreAGG = "" Or strPreAGG <> Trim(Mid(cell, 22, 13)) Then
strPreAGG = Trim(Mid(cell, 22, 13))
strPostAGG = Trim(Mid(cell, 59, 11))
strCompression = Trim(Right(cell, 4))
strRenovated = Trim(Mid(cell, 38, 12))
strRenopercent = Trim(Mid(cell, 53, 4))
If InStr(cell, "TOTAL") = 0 Then
cell.Select
If IsNumeric(strPreAGG) And IsNumeric(strPostAGG) Then
Set rngOut = Worksheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0)
rngOut.Offset(0, 0) = strDate
rngOut.Offset(0, 1) = strPreAGG
rngOut.Offset(0, 2) = strPostAGG
rngOut.Offset(0, 3) = strCompression
rngOut.Offset(0, 4) = strRenovated
rngOut.Offset(0, 5) = strRenopercent
End If
End If
End If
Next cell
End Sub

Private Sub ExtractDataY_Click()
' Local Variables
Dim cell As Range, rngOut As Range
Dim strDate As String, strTable As String
Dim strPreAGG As String, strPostAGG As String, strCompression As String
Dim strRenovated As String, strRenopercent As String

' Read data
For Each cell In Me.Range("rdi_TableTop", "A" & Me.Range("A65536").End(xlUp).Row)
If ActiveSheet.Name = Me.Name Then cell.Select

' Get effective date
If InStr(cell, "AGGREGATION METRICS:") > 0 Then
If strDate = "" Or strDate <> Right(cell, 10) Then strDate = Right(cell, 10)
strDate = Format(strDate, "mm/dd/yyyy")
End If

' Get Global House Count:
If InStr(cell, "GLOBAL HOUSE COUNT:") > 0 Then
'If strPreAGG = "" Or strPreAGG <> Trim(Mid(cell, 22, 13)) Then
strPreAGG = Trim(Mid(cell, 24, 13))
strPostAGG = Trim(Mid(cell, 41, 16))
strCompression = Trim(Right(cell, 4))
If InStr(cell, "TOTAL") = 0 Then
cell.Select
If IsNumeric(strPreAGG) And IsNumeric(strPostAGG) Then
*Set rngOut = Worksheets("Sheet1").Range("A65536").End(xlUp).Offset(0, -ActiveCell.Column + 1) *
rngOut.Offset(0, 0) = strDate
rngOut.Offset(0, 1) = strPreAGG
rngOut.Offset(0, 2) = strPostAGG
rngOut.Offset(0, 3) = strCompression
End If
End If
End If
Next cell
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Export to PDF 0
VBA Coding Help for Beginner 0
Word macro that can call cells out of Excel for a find and replace 0
Macro help 0
Seaching an excel sheet 1
For-Next by a row Counting consecutive Zero in the column 4
Code does not error but no copy either 4
type mismatch error in macro in excel 0

Top