Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
Would someone please help me with a macro? I have data on a sheet that I am
trying to selectively move to a summary sheet; below is an example: Revenue Net $1,296.00 $24.00 Revenue Net $964.00 ($28.00) Revenue Net $416.00 ($40.00) $416.00 ($40.00) $416.00 ($40.00) There are blocks of data on a sheet. Each block has a different number of rows. Each block is seperated by one blank row. In column P is the heading "Net" in each block. Under "Net" can be blanks or a dollar amount or the blank between blocks of data or a new heading of "Net" for a new block of data. I am trying to move the dollar amount to a summary sheet. Sometimes there is more than one dollar amount in each block... I only want the first instance of the dollar amount then I need to skip to the next block and get the first instance of the dollar amount in that next block. Sometimes there is no dollar amount and then I would have to skip to the next block of data. When/if I find the dollar amount I need to copy and paste it to the summary sheet and also copy and past the values in that same row from column A (an ID) and column B (the end date). The value 2nd from the top of the column B in that block of data is the "start" date. I need to capture the start date too and move it to the summary sheet. In summary the macro would grab 4 bits of data and move it to the summary sheet and then move on to the next block of data a grab and move 4 bits of data from that block, etc. I have been working hard with loops and cases and if's for a week and can't quite get it so any help is very appreciated with big thanks. -- John Yab |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
I don't have the spreadsheet so there may be an error with the code. but is is very close. Try this Enum States FindNet = 1 FindAmount = 2 End Enum Sub MakeSummary() Dim State As States NewRow = 2 Set SumSht = Sheets("Summary") Set OldSht = ActiveSheet State = FindNet With OldSht LastRow = .Range("P" & Rows.Count).End(xlUp).Row For RowCount = 2 To LastRow Data = .Range("P" & RowCount) Select Case State Case FindNet: If Data = "Revenue Net" Then State = FindAmount StartDate = .Range("B" & (RowCount + 1)) End If Case FindAmount: If Data < "" Then 'found first dollar amount ID = .Range("A" & RowCount) EndDate = .Range("B" & RowCount) With SumSht .Range("A" & NewRow) = ID .Range("B" & NewRow) = StartDate .Range("C" & NewRow) = EndDate .Range("D" & NewRow) = Data NewRow = NewRow + 1 End With State = FindNet End If End Select Next RowCount End With End Sub -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=146619 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
Hi and Thanks Joel and The Code Cage, I am thrilled with your reply and the results. The results are very close to perfect... I should have included a bit more information. I have attached a sample workbook with the last sheet showing the results from running the macro... very impressive!! I changed "Revenue Net" to "Net" but I am missing some information at the top or the bottom of the summary sheet depending on what code I change and there are a couple of lines in the summary that are titles that I don't know how to not have copied over. The workbook is acutally many sheets but I included just a couple to keep it smaller. Each one of the sheets that has the data to collect has the word "Ticker" in A1 (there are other sheets too) and I am thinking that I should be able to probably write the code to cycle through all the "Ticker" worksheets to have a cumulative summary. I am super grateful for your help, Thanks, John Yab John Yab;533513 Wrote: Would someone please help me with a macro? I have data on a sheet that I am trying to selectively move to a summary sheet; below is an example: Revenue Net $1,296.00 $24.00 Revenue Net $964.00 ($28.00) Revenue Net $416.00 ($40.00) $416.00 ($40.00) $416.00 ($40.00) There are blocks of data on a sheet. Each block has a different number of rows. Each block is seperated by one blank row. In column P is the heading "Net" in each block. Under "Net" can be blanks or a dollar amount or the blank between blocks of data or a new heading of "Net" for a new block of data. I am trying to move the dollar amount to a summary sheet. Sometimes there is more than one dollar amount in each block... I only want the first instance of the dollar amount then I need to skip to the next block and get the first instance of the dollar amount in that next block. Sometimes there is no dollar amount and then I would have to skip to the next block of data. When/if I find the dollar amount I need to copy and paste it to the summary sheet and also copy and past the values in that same row from column A (an ID) and column B (the end date). The value 2nd from the top of the column B in that block of data is the "start" date. I need to capture the start date too and move it to the summary sheet. In summary the macro would grab 4 bits of data and move it to the summary sheet and then move on to the next block of data a grab and move 4 bits of data from that block, etc. I have been working hard with loops and cases and if's for a week and can't quite get it so any help is very appreciated with big thanks. -- John Yab +-------------------------------------------------------------------+ |Filename: Position calculator Joel.xlsm | |Download: http://www.thecodecage.com/forumz/attachment.php?attachmentid=341| +-------------------------------------------------------------------+ -- John Yab ------------------------------------------------------------------------ John Yab's Profile: http://www.thecodecage.com/forumz/me...hp?userid=1074 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=146619 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
the only change I made was to start at row 1 instead of row 2. I also added a header row to the summary sheet and add code to move through all the sheets. The extra rows are included because you don't have formulas in column P for some of the data. The code is finding Net and then a 2nd Net without any amounts inbetween. I don't know if this is an error or you want me to eliminate the extra rows. I can easily make the change but didn't want to do this unless you agree. Having a BSEE helps in writing this type of code because it is based on algorithms that are taught in electrical engineering courses. then it doesn't hurt to also have a Master in computer science for writing software. People say my code is eligant! Enum States FindNet = 1 FindAmount = 2 End Enum Sub MakeSummary() Dim State As States NewRow = 2 Set Sumsht = Sheets("Summary") With Sumsht Range("A1") = "ID" Range("B1") = "Start Date" Range("C1") = "End Date" Range("D1") = "Net" End With For Each OldSht In Sheets With OldSht If .Range("A1") = "Ticker" Then State = FindNet LastRow = .Range("P" & Rows.Count).End(xlUp).Row For RowCount = 1 To LastRow Data = .Range("P" & RowCount) Select Case State Case FindNet: If Data = "Net" Then State = FindAmount startDate = .Range("B" & (RowCount + 1)) End If Case FindAmount: If Data < "" Then 'found first dollar amount ID = .Range("A" & RowCount) endDate = .Range("B" & RowCount) With Sumsht Range("A" & NewRow) = ID Range("B" & NewRow) = startDate Range("C" & NewRow) = endDate Range("D" & NewRow) = Data NewRow = NewRow + 1 End With State = FindNet End If End Select Next RowCount End If End With Next OldSht End Sub -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=146619 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
Hi Don,
Thank you so much for your help. Your code is fantastic. You do so much with such few lines of code. It turns out I am struggling a bit trying to get it to cycle through all the sheets with €śTicker€ť in A1. I will keep trying but your help would be very appreciated. I made a mistake with writing up the desired outcome by saying that I wanted to skip blocks of data that dont have €śnet€ť dollar amounts in column P. I now realize that in those instances I would really like the macro to return the: symbol, the start date as the top date of the column for its block, the end date as the bottom date of its block and the dollar net amount to be blank. Thanks so much. -- John Yab "Don Guillett" wrote: Sub GetDataSAS() 'insert a row at the top of the sheet Application.ScreenUpdating = False Dim r As Long Dim lr As Long Dim c As Range r = 2 lr = Cells(Rows.Count, 1).End(xlUp).Row With Worksheets(1).Range("p1:p" & lr) Set c = .Find(What:="Net", After:=Range("p1"), LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False) If Not c Is Nothing Then firstAddress = c.Address Do firstvaluerow = Evaluate("=MATCH(1,--(P" & c.Row + 1 & ":P" & lr & "<""""),0)") + c.Row If LCase(Cells(firstvaluerow, "P")) < "net" Then With Sheets("summary") ..Cells(r, "e") = Cells(c.Row + 1, 1) 'symbol ..Cells(r, "f") = Cells(c.Row + 1, 2) 'startdate ..Cells(r, "g") = Cells(firstvaluerow, "B") 'enddate ..Cells(r, "h") = Cells(firstvaluerow, "P") 'endvalue End With r = r + 1 End If Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstAddress End If End With Application.ScreenUpdating = True End Sub -- Don Guillett Microsoft MVP Excel SalesAid Software "Don Guillett" wrote in message ... If desired, send your file to my address below. I will only look if: 1. You send a copy of this message on an inserted sheet 2. You give me the newsgroup and the subject line 3. You send a clear explanation of what you want 4. You send before/after examples and expected results. -- Don Guillett Microsoft MVP Excel SalesAid Software "John Yab" wrote in message ... Would someone please help me with a macro? I have data on a sheet that I am trying to selectively move to a summary sheet; below is an example: Revenue Net $1,296.00 $24.00 Revenue Net $964.00 ($28.00) Revenue Net $416.00 ($40.00) $416.00 ($40.00) $416.00 ($40.00) There are blocks of data on a sheet. Each block has a different number of rows. Each block is seperated by one blank row. In column P is the heading "Net" in each block. Under "Net" can be blanks or a dollar amount or the blank between blocks of data or a new heading of "Net" for a new block of data. I am trying to move the dollar amount to a summary sheet. Sometimes there is more than one dollar amount in each block... I only want the first instance of the dollar amount then I need to skip to the next block and get the first instance of the dollar amount in that next block. Sometimes there is no dollar amount and then I would have to skip to the next block of data. When/if I find the dollar amount I need to copy and paste it to the summary sheet and also copy and past the values in that same row from column A (an ID) and column B (the end date). The value 2nd from the top of the column B in that block of data is the "start" date. I need to capture the start date too and move it to the summary sheet. In summary the macro would grab 4 bits of data and move it to the summary sheet and then move on to the next block of data a grab and move 4 bits of data from that block, etc. I have been working hard with loops and cases and if's for a week and can't quite get it so any help is very appreciated with big thanks. -- John Yab . |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
Hi Joel,
Thanks. Wow. I had not even seen code like yours, before. It gets real close to the desired resullts. It doesn't return results to the summary sheet for the last block of data that it collects data from, though. I have tried for hours to modify your code to adjust for that but I just can't get it. Your code is at a high level I have not got to yet. Can you modify it a bit to eliminate the extra summary rows caused by the areas in column P that don't have formulas? I made a mistake with writing up the desired outcome by saying that I wanted to skip blocks of data that dont have €śnet€ť dollar amounts in column P. I now realize that in those instances I would really like the macro to return the: symbol, the start date as the top date of the column for its block, the end date as the bottom date of its block and the dollar net amount to be blank. I will keep trying on my own and appreciate your help. I will also have to do more research to learn about some new concepts that your code has shown me. Thank you very much. -- John Yab "joel" wrote: I don't have the spreadsheet so there may be an error with the code. but is is very close. Try this Enum States FindNet = 1 FindAmount = 2 End Enum Sub MakeSummary() Dim State As States NewRow = 2 Set SumSht = Sheets("Summary") Set OldSht = ActiveSheet State = FindNet With OldSht LastRow = .Range("P" & Rows.Count).End(xlUp).Row For RowCount = 2 To LastRow Data = .Range("P" & RowCount) Select Case State Case FindNet: If Data = "Revenue Net" Then State = FindAmount StartDate = .Range("B" & (RowCount + 1)) End If Case FindAmount: If Data < "" Then 'found first dollar amount ID = .Range("A" & RowCount) EndDate = .Range("B" & RowCount) With SumSht .Range("A" & NewRow) = ID .Range("B" & NewRow) = StartDate .Range("C" & NewRow) = EndDate .Range("D" & NewRow) = Data NewRow = NewRow + 1 End With State = FindNet End If End Select Next RowCount End With End Sub -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=146619 . |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
Hi Joel, Thanks. Wow. I had not even seen code like yours, before. It gets real close to the desired results. It doesn't return results to the summary sheet for the last block of data that it collects data from, though. I have tried for hours to modify your code to adjust for that but I just can't get it. Your code is at a high level I have not got to yet. Can you modify it a bit to eliminate the extra summary rows caused by the areas in column P that don't have formulas? I made a mistake with writing up the desired outcome by saying that I wanted to skip blocks of data that don’t have “net” dollar amounts in column P. I now realize that in those instances I would really like the macro to return the: symbol, the start date as the top date of the column for its block, the end date as the bottom date of its block and the dollar net amount to be blank. I will keep trying on my own and appreciate your help. I will also have to do more research to learn about some new concepts that your code has shown me. Thank you very much. joel;534176 Wrote: the only change I made was to start at row 1 instead of row 2. I also added a header row to the summary sheet and add code to move through all the sheets. The extra rows are included because you don't have formulas in column P for some of the data. The code is finding Net and then a 2nd Net without any amounts inbetween. I don't know if this is an error or you want me to eliminate the extra rows. I can easily make the change but didn't want to do this unless you agree. Having a BSEE helps in writing this type of code because it is based on algorithms that are taught in electrical engineering courses. then it doesn't hurt to also have a Master in computer science for writing software. People say my code is eligant! Enum States FindNet = 1 FindAmount = 2 End Enum Sub MakeSummary() Dim State As States NewRow = 2 Set Sumsht = Sheets("Summary") With Sumsht .Range("A1") = "ID" .Range("B1") = "Start Date" .Range("C1") = "End Date" .Range("D1") = "Net" End With For Each OldSht In Sheets With OldSht If .Range("A1") = "Ticker" Then State = FindNet LastRow = .Range("P" & Rows.Count).End(xlUp).Row For RowCount = 1 To LastRow Data = .Range("P" & RowCount) Select Case State Case FindNet: If Data = "Net" Then State = FindAmount startDate = .Range("B" & (RowCount + 1)) End If Case FindAmount: If Data < "" Then 'found first dollar amount ID = .Range("A" & RowCount) endDate = .Range("B" & RowCount) With Sumsht .Range("A" & NewRow) = ID .Range("B" & NewRow) = startDate .Range("C" & NewRow) = endDate .Range("D" & NewRow) = Data NewRow = NewRow + 1 End With State = FindNet End If End Select Next RowCount End If End With Next OldSht End Sub -- John Yab ------------------------------------------------------------------------ John Yab's Profile: http://www.thecodecage.com/forumz/me...hp?userid=1074 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=146619 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
I added one IF statnement which fixes both problems. Because the code didn't find an amount the code thought "Net" was the amount and then started to search for the next Net" . It turned out the data that was missing amounts was the 2nd to last section of data so it skipped the last section on the page. My code has memory in the fact it rembers what data it found and uses that information in finding the next piece of information. the code basically remember that it found the word "Net" or found a dollar amount. If the code finds a dollar amount it does noting (skipping all the other dollar amount) until it find the word "Net". I've been writing code like this for over 30 years starting with FORTRAN amoung other programming languages. Enum States FindNet = 1 FindAmount = 2 End Enum Sub MakeSummary() Dim State As States NewRow = 2 Set Sumsht = Sheets("Summary") With Sumsht .Range("A1") = "ID" .Range("B1") = "Start Date" .Range("C1") = "End Date" .Range("D1") = "Net" End With For Each OldSht In Sheets With OldSht If .Range("A1") = "Ticker" Then State = FindNet LastRow = .Range("P" & Rows.Count).End(xlUp).Row For RowCount = 1 To LastRow Data = .Range("P" & RowCount) Select Case State Case FindNet: If Data = "Net" Then State = FindAmount startDate = .Range("B" & (RowCount + 1)) End If Case FindAmount: If Data < "" Then If Data < "Net" Then 'found first dollar amount ID = .Range("A" & RowCount) endDate = .Range("B" & RowCount) With Sumsht .Range("A" & NewRow) = ID .Range("B" & NewRow) = startDate .Range("C" & NewRow) = endDate .Range("D" & NewRow) = Data NewRow = NewRow + 1 End With State = FindNet End If End If End Select Next RowCount End If End With Next OldSht End Sub -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=146619 |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
Hi Joel,
It works. It's cool. Thank you very much. I tried all evening to make a modification when there isn't €śnet€ť dollar amounts in column P in a block: to to return the: symbol, the start date as the top date of the column for its block, the end date as the bottom date of its block and the dollar net amount to be blank or 0. I thought if I put in a 0 at the end of column P of those blocks empty of "net" then your code would return entries to the summary sheet. I haven't got that mod to work yet, below is the code. Would you be able to help a bit more? Also where can I learn about: "Enum States", "FindNet = 1", "End Enum" kind of code... a book you could recomend, maybe? Thanks so much. Enum States FindNet = 1 FindAmount = 2 End Enum Sub MakeSummaryVJ15() Dim State As States 'Delete the sheet "Summary" if it exist Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets("Summary").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a new summary worksheet. Set Sumsht = ActiveWorkbook.Worksheets.Add(after:=Worksheets(Wo rksheets.Count)) Sumsht.Name = "Summary" 'Set up titles 'Range("A1:D1") = Array("Symbol", "Start", "End", "Net") Columns("B:D").HorizontalAlignment = xlRight NewRow = 2 'Set Sumsht = Sheets("Summary") With Sumsht ..Range("A1") = "Symbol" ..Range("B1") = "Start" ..Range("C1") = "End" ..Range("D1") = "Net" ..Rows("1:1").Font.Bold = True End With For Each OldSht In Sheets With OldSht If .Range("A1") = "Ticker" Then State = FindNet LastRow = .Range("P" & Rows.Count).End(xlUp).Row For RowCount = 1 To LastRow Data = .Range("P" & RowCount) Select Case State Case FindNet: If Data = "Net" Then State = FindAmount startDate = .Range("B" & (RowCount + 1)) End If Case FindAmount: 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx If Data = "" Then Cells.Offset(-2, 0).Value = "0" ElseIf Data < "" Then If Data < "Net" Then 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 'found first dollar amount ID = .Range("A" & RowCount) endDate = .Range("B" & RowCount) With Sumsht ..Range("A" & NewRow) = ID ..Range("B" & NewRow) = startDate ..Range("C" & NewRow) = endDate ..Range("D" & NewRow) = Data NewRow = NewRow + 1 End With State = FindNet End If End If End Select Next RowCount End If End With Next OldSht End Sub -- John Yab "joel" wrote: I added one IF statnement which fixes both problems. Because the code didn't find an amount the code thought "Net" was the amount and then started to search for the next Net" . It turned out the data that was missing amounts was the 2nd to last section of data so it skipped the last section on the page. My code has memory in the fact it rembers what data it found and uses that information in finding the next piece of information. the code basically remember that it found the word "Net" or found a dollar amount. If the code finds a dollar amount it does noting (skipping all the other dollar amount) until it find the word "Net". I've been writing code like this for over 30 years starting with FORTRAN amoung other programming languages. Enum States FindNet = 1 FindAmount = 2 End Enum Sub MakeSummary() Dim State As States NewRow = 2 Set Sumsht = Sheets("Summary") With Sumsht .Range("A1") = "ID" .Range("B1") = "Start Date" .Range("C1") = "End Date" .Range("D1") = "Net" End With For Each OldSht In Sheets With OldSht If .Range("A1") = "Ticker" Then State = FindNet LastRow = .Range("P" & Rows.Count).End(xlUp).Row For RowCount = 1 To LastRow Data = .Range("P" & RowCount) Select Case State Case FindNet: If Data = "Net" Then State = FindAmount startDate = .Range("B" & (RowCount + 1)) End If Case FindAmount: If Data < "" Then If Data < "Net" Then 'found first dollar amount ID = .Range("A" & RowCount) endDate = .Range("B" & RowCount) With Sumsht .Range("A" & NewRow) = ID .Range("B" & NewRow) = startDate .Range("C" & NewRow) = endDate .Range("D" & NewRow) = Data NewRow = NewRow + 1 End With State = FindNet End If End If End Select Next RowCount End If End With Next OldSht End Sub -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=146619 . |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
As you can see it gets more complicated, but not significantly. the ENUM can be found in the VBA help.It does two things. It creates a new type that you can use in a DIM statement. It also give a unique value to each item in the ENUM. I could of done the same thing using a CONST, but I wouldn't of been able to use the TYPE States in a Dim statement. The number 1 and 2 could of been anything as long as they were different. I fcould of set then to -1 and +1 or to "A" and "B" or "boy" and "girl". As long as they were different. Enum States FindNet = 1 FindAmount = 2 End Enum Sub MakeSummaryVJ15() Dim State As States 'Delete the sheet "Summary" if it exist Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets("Summary").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a new summary worksheet. Set Sumsht = _ ActiveWorkbook.Worksheets.Add(after:=Worksheets(Wo rksheets.Count)) Sumsht.Name = "Summary" NewRow = 2 With Sumsht Columns("B:D").HorizontalAlignment = xlRight Range("A1") = "Symbol" Range("B1") = "Start" Range("C1") = "End" Range("D1") = "Net" Rows("1:1").Font.Bold = True End With For Each OldSht In Sheets With OldSht If .Range("A1") = "Ticker" Then State = FindNet LastRow = .Range("P" & Rows.Count).End(xlUp).Row For RowCount = 1 To LastRow Data = .Range("P" & RowCount) Select Case State Case FindNet: If Data = "Net" Then State = FindAmount ID = .Range("A" & (RowCount + 1)) StartDate = .Range("B" & (RowCount + 1)) EndDate = .Range("B" & RowCount) End If Case FindAmount: 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 'collect last end date of block If .Range("A" & RowCount) < "" And _ Data < "Net" Then EndDate = .Range("B" & RowCount) End If If Data < "" Or _ RowCount = LastRow Then With Sumsht Range("A" & NewRow) = ID Range("B" & NewRow) = StartDate Range("C" & NewRow) = EndDate If Data = "Net" Then Range("D" & NewRow) = 0 ID = OldSht.Range("A" & (RowCount + 1)) StartDate = OldSht.Range("B" & (RowCount + 1)) EndDate = OldSht.Range("B" & RowCount) Else 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 'found first dollar amount Range("D" & NewRow) = Data State = FindNet End If NewRow = NewRow + 1 End With End If End Select Next RowCount End If End With Next OldSht End Sub -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=146619 |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
It's perfect.
I can't thank you enough. I have been working on this every evening and all last weekend for over a week. Not only is it perfect but now I can learn the new concepts that you have shown me. Totally grateful, thank you. -- John Yab "joel" wrote: As you can see it gets more complicated, but not significantly. the ENUM can be found in the VBA help.It does two things. It creates a new type that you can use in a DIM statement. It also give a unique value to each item in the ENUM. I could of done the same thing using a CONST, but I wouldn't of been able to use the TYPE States in a Dim statement. The number 1 and 2 could of been anything as long as they were different. I fcould of set then to -1 and +1 or to "A" and "B" or "boy" and "girl". As long as they were different. Enum States FindNet = 1 FindAmount = 2 End Enum Sub MakeSummaryVJ15() Dim State As States 'Delete the sheet "Summary" if it exist Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets("Summary").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a new summary worksheet. Set Sumsht = _ ActiveWorkbook.Worksheets.Add(after:=Worksheets(Wo rksheets.Count)) Sumsht.Name = "Summary" NewRow = 2 With Sumsht Columns("B:D").HorizontalAlignment = xlRight .Range("A1") = "Symbol" .Range("B1") = "Start" .Range("C1") = "End" .Range("D1") = "Net" .Rows("1:1").Font.Bold = True End With For Each OldSht In Sheets With OldSht If .Range("A1") = "Ticker" Then State = FindNet LastRow = .Range("P" & Rows.Count).End(xlUp).Row For RowCount = 1 To LastRow Data = .Range("P" & RowCount) Select Case State Case FindNet: If Data = "Net" Then State = FindAmount ID = .Range("A" & (RowCount + 1)) StartDate = .Range("B" & (RowCount + 1)) EndDate = .Range("B" & RowCount) End If Case FindAmount: 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 'collect last end date of block If .Range("A" & RowCount) < "" And _ Data < "Net" Then EndDate = .Range("B" & RowCount) End If If Data < "" Or _ RowCount = LastRow Then With Sumsht .Range("A" & NewRow) = ID .Range("B" & NewRow) = StartDate .Range("C" & NewRow) = EndDate If Data = "Net" Then .Range("D" & NewRow) = 0 ID = OldSht.Range("A" & (RowCount + 1)) StartDate = OldSht.Range("B" & (RowCount + 1)) EndDate = OldSht.Range("B" & RowCount) Else 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 'found first dollar amount .Range("D" & NewRow) = Data State = FindNet End If NewRow = NewRow + 1 End With End If End Select Next RowCount End If End With Next OldSht End Sub -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=146619 . |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
I know how difficult code like this can be. But I've been writing it for sooo long I know all the problems just by seing the data and usually get it correct the 1st time. If you noticed I move where theh edDate is being read from the worksheet. Since you need the last occurance I had to read it at every line instead of just the last line becasue if you don't have nay amounts in Net Column (reach the next "Net") you won't have the proper EndDate. I also made a change incase the last group of data did have any amount in column P. I added in one of the IF statements "RowCount = LastRow" to handle this case. In this case I found one error in my checking. I was expecting 3 occrances of the Net amount equal 0 (no amount in column P). I only had two and had to find the problem. I found quickly I had to move the line "State = FindNet" -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=146619 |
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
This also works
Sub GetDataAllSheetsSAS() 'insert a row at the top of the sheet Application.ScreenUpdating = False Dim ws As Worksheet Dim firstaddress Dim r As Long Dim lr As Long Dim i As Long Dim c As Range With Sheets("Summary") lr = .Cells(Rows.Count, 1).End(xlUp).Row ..Rows(2).Resize(lr).Delete End With r = 2 For Each ws In Worksheets If ws.Name < "Summary" And ws.Range("a1") = "Ticker" Then lr = ws.Cells(Rows.Count, "a").End(xlUp).Row With ws.Range("p1:p" & lr) Set c = .Find(What:="Net", after:=ws.Range("p" & lr), LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False) If Not c Is Nothing Then firstaddress = c.Address Do With Sheets("summary") ..Cells(r, "e") = ws.Name ..Cells(r, "a") = ws.Cells(c.Row + 1, 1) 'symbol ..Cells(r, "b") = ws.Cells(c.Row + 1, 2) 'startdate ..Cells(r, "c") = ws.Cells(c.Row + 1, 2).End(xlDown) 'enddate For i = c.Row + 1 To ws.Cells(Rows.Count, 1).End(xlUp).Row If Len(ws.Cells(i, "p")) 0 Then If ws.Cells(i, "p") = "Net" Then ..Cells(r, "d") = 0 'end value Else ..Cells(r, "d") = ws.Cells(i, "p") 'end value End If Exit For End If Next i End With r = r + 1 Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstaddress End If End With End If 'MsgBox ws.Name Next ws Application.ScreenUpdating = True End Sub -- Don Guillett Microsoft MVP Excel SalesAid Software "Don Guillett" wrote in message ... Sub GetDataSAS() 'insert a row at the top of the sheet Application.ScreenUpdating = False Dim r As Long Dim lr As Long Dim c As Range r = 2 lr = Cells(Rows.Count, 1).End(xlUp).Row With Worksheets(1).Range("p1:p" & lr) Set c = .Find(What:="Net", After:=Range("p1"), LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False) If Not c Is Nothing Then firstAddress = c.Address Do firstvaluerow = Evaluate("=MATCH(1,--(P" & c.Row + 1 & ":P" & lr & "<""""),0)") + c.Row If LCase(Cells(firstvaluerow, "P")) < "net" Then With Sheets("summary") .Cells(r, "e") = Cells(c.Row + 1, 1) 'symbol .Cells(r, "f") = Cells(c.Row + 1, 2) 'startdate .Cells(r, "g") = Cells(firstvaluerow, "B") 'enddate .Cells(r, "h") = Cells(firstvaluerow, "P") 'endvalue End With r = r + 1 End If Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstAddress End If End With Application.ScreenUpdating = True End Sub -- Don Guillett Microsoft MVP Excel SalesAid Software "Don Guillett" wrote in message ... If desired, send your file to my address below. I will only look if: 1. You send a copy of this message on an inserted sheet 2. You give me the newsgroup and the subject line 3. You send a clear explanation of what you want 4. You send before/after examples and expected results. -- Don Guillett Microsoft MVP Excel SalesAid Software "John Yab" wrote in message ... Would someone please help me with a macro? I have data on a sheet that I am trying to selectively move to a summary sheet; below is an example: Revenue Net $1,296.00 $24.00 Revenue Net $964.00 ($28.00) Revenue Net $416.00 ($40.00) $416.00 ($40.00) $416.00 ($40.00) There are blocks of data on a sheet. Each block has a different number of rows. Each block is seperated by one blank row. In column P is the heading "Net" in each block. Under "Net" can be blanks or a dollar amount or the blank between blocks of data or a new heading of "Net" for a new block of data. I am trying to move the dollar amount to a summary sheet. Sometimes there is more than one dollar amount in each block... I only want the first instance of the dollar amount then I need to skip to the next block and get the first instance of the dollar amount in that next block. Sometimes there is no dollar amount and then I would have to skip to the next block of data. When/if I find the dollar amount I need to copy and paste it to the summary sheet and also copy and past the values in that same row from column A (an ID) and column B (the end date). The value 2nd from the top of the column B in that block of data is the "start" date. I need to capture the start date too and move it to the summary sheet. In summary the macro would grab 4 bits of data and move it to the summary sheet and then move on to the next block of data a grab and move 4 bits of data from that block, etc. I have been working hard with loops and cases and if's for a week and can't quite get it so any help is very appreciated with big thanks. -- John Yab |
#15
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
when they say something "isn't" rocket science my code is rocket science. to launch a rocket you need to perform a specific sequence of Events 10 9 8 7 6 5 4 3 2 1 0 fire This is an enumeration -10, -9, -8, -7, -6, -5, -4, -3, -2, -1, 0, +1, +2, +3 ........ -10 turn on gas -9 ignite gase -1 relese holding down clamps 0 lift off If these event don't happen in the precise order specified above the rocket dosn't launch. If the gas turns on at -3 the rocket blows up because the liguid gas is explosive. If the hold down clamps open at -8 there isn't enough momentum for the rocket to take off straight in the air and the rocket tips over and fires horizontal instead of verticle. You problme was similar in that event happed in a specfic sequence. -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=146619 |
#16
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
OOPs NOT necessary to insert a row at the top
-- Don Guillett Microsoft MVP Excel SalesAid Software "Don Guillett" wrote in message ... This also works Sub GetDataAllSheetsSAS() 'insert a row at the top of the sheet Application.ScreenUpdating = False Dim ws As Worksheet Dim firstaddress Dim r As Long Dim lr As Long Dim i As Long Dim c As Range With Sheets("Summary") lr = .Cells(Rows.Count, 1).End(xlUp).Row .Rows(2).Resize(lr).Delete End With r = 2 For Each ws In Worksheets If ws.Name < "Summary" And ws.Range("a1") = "Ticker" Then lr = ws.Cells(Rows.Count, "a").End(xlUp).Row With ws.Range("p1:p" & lr) Set c = .Find(What:="Net", after:=ws.Range("p" & lr), LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False) If Not c Is Nothing Then firstaddress = c.Address Do With Sheets("summary") .Cells(r, "e") = ws.Name .Cells(r, "a") = ws.Cells(c.Row + 1, 1) 'symbol .Cells(r, "b") = ws.Cells(c.Row + 1, 2) 'startdate .Cells(r, "c") = ws.Cells(c.Row + 1, 2).End(xlDown) 'enddate For i = c.Row + 1 To ws.Cells(Rows.Count, 1).End(xlUp).Row If Len(ws.Cells(i, "p")) 0 Then If ws.Cells(i, "p") = "Net" Then .Cells(r, "d") = 0 'end value Else .Cells(r, "d") = ws.Cells(i, "p") 'end value End If Exit For End If Next i End With r = r + 1 Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstaddress End If End With End If 'MsgBox ws.Name Next ws Application.ScreenUpdating = True End Sub -- Don Guillett Microsoft MVP Excel SalesAid Software "Don Guillett" wrote in message ... Sub GetDataSAS() 'insert a row at the top of the sheet Application.ScreenUpdating = False Dim r As Long Dim lr As Long Dim c As Range r = 2 lr = Cells(Rows.Count, 1).End(xlUp).Row With Worksheets(1).Range("p1:p" & lr) Set c = .Find(What:="Net", After:=Range("p1"), LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False) If Not c Is Nothing Then firstAddress = c.Address Do firstvaluerow = Evaluate("=MATCH(1,--(P" & c.Row + 1 & ":P" & lr & "<""""),0)") + c.Row If LCase(Cells(firstvaluerow, "P")) < "net" Then With Sheets("summary") .Cells(r, "e") = Cells(c.Row + 1, 1) 'symbol .Cells(r, "f") = Cells(c.Row + 1, 2) 'startdate .Cells(r, "g") = Cells(firstvaluerow, "B") 'enddate .Cells(r, "h") = Cells(firstvaluerow, "P") 'endvalue End With r = r + 1 End If Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstAddress End If End With Application.ScreenUpdating = True End Sub -- Don Guillett Microsoft MVP Excel SalesAid Software "Don Guillett" wrote in message ... If desired, send your file to my address below. I will only look if: 1. You send a copy of this message on an inserted sheet 2. You give me the newsgroup and the subject line 3. You send a clear explanation of what you want 4. You send before/after examples and expected results. -- Don Guillett Microsoft MVP Excel SalesAid Software "John Yab" wrote in message ... Would someone please help me with a macro? I have data on a sheet that I am trying to selectively move to a summary sheet; below is an example: Revenue Net $1,296.00 $24.00 Revenue Net $964.00 ($28.00) Revenue Net $416.00 ($40.00) $416.00 ($40.00) $416.00 ($40.00) There are blocks of data on a sheet. Each block has a different number of rows. Each block is seperated by one blank row. In column P is the heading "Net" in each block. Under "Net" can be blanks or a dollar amount or the blank between blocks of data or a new heading of "Net" for a new block of data. I am trying to move the dollar amount to a summary sheet. Sometimes there is more than one dollar amount in each block... I only want the first instance of the dollar amount then I need to skip to the next block and get the first instance of the dollar amount in that next block. Sometimes there is no dollar amount and then I would have to skip to the next block of data. When/if I find the dollar amount I need to copy and paste it to the summary sheet and also copy and past the values in that same row from column A (an ID) and column B (the end date). The value 2nd from the top of the column B in that block of data is the "start" date. I need to capture the start date too and move it to the summary sheet. In summary the macro would grab 4 bits of data and move it to the summary sheet and then move on to the next block of data a grab and move 4 bits of data from that block, etc. I have been working hard with loops and cases and if's for a week and can't quite get it so any help is very appreciated with big thanks. -- John Yab |
#17
Posted to microsoft.public.excel.programming
|
|||
|
|||
Selectively Moving Data to a Summary Sheet
Thanks Don,
Yes yours works perfectly too. I have run it many times and will now study it to learn from it. Hopefully one day I will be able to help by providing answers like you have kindly done for me. Thank you very much for working on this for me. -- John Yab "Don Guillett" wrote: OOPs NOT necessary to insert a row at the top -- Don Guillett Microsoft MVP Excel SalesAid Software "Don Guillett" wrote in message ... This also works Sub GetDataAllSheetsSAS() 'insert a row at the top of the sheet Application.ScreenUpdating = False Dim ws As Worksheet Dim firstaddress Dim r As Long Dim lr As Long Dim i As Long Dim c As Range With Sheets("Summary") lr = .Cells(Rows.Count, 1).End(xlUp).Row .Rows(2).Resize(lr).Delete End With r = 2 For Each ws In Worksheets If ws.Name < "Summary" And ws.Range("a1") = "Ticker" Then lr = ws.Cells(Rows.Count, "a").End(xlUp).Row With ws.Range("p1:p" & lr) Set c = .Find(What:="Net", after:=ws.Range("p" & lr), LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False) If Not c Is Nothing Then firstaddress = c.Address Do With Sheets("summary") .Cells(r, "e") = ws.Name .Cells(r, "a") = ws.Cells(c.Row + 1, 1) 'symbol .Cells(r, "b") = ws.Cells(c.Row + 1, 2) 'startdate .Cells(r, "c") = ws.Cells(c.Row + 1, 2).End(xlDown) 'enddate For i = c.Row + 1 To ws.Cells(Rows.Count, 1).End(xlUp).Row If Len(ws.Cells(i, "p")) 0 Then If ws.Cells(i, "p") = "Net" Then .Cells(r, "d") = 0 'end value Else .Cells(r, "d") = ws.Cells(i, "p") 'end value End If Exit For End If Next i End With r = r + 1 Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstaddress End If End With End If 'MsgBox ws.Name Next ws Application.ScreenUpdating = True End Sub -- Don Guillett Microsoft MVP Excel SalesAid Software "Don Guillett" wrote in message ... Sub GetDataSAS() 'insert a row at the top of the sheet Application.ScreenUpdating = False Dim r As Long Dim lr As Long Dim c As Range r = 2 lr = Cells(Rows.Count, 1).End(xlUp).Row With Worksheets(1).Range("p1:p" & lr) Set c = .Find(What:="Net", After:=Range("p1"), LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False) If Not c Is Nothing Then firstAddress = c.Address Do firstvaluerow = Evaluate("=MATCH(1,--(P" & c.Row + 1 & ":P" & lr & "<""""),0)") + c.Row If LCase(Cells(firstvaluerow, "P")) < "net" Then With Sheets("summary") .Cells(r, "e") = Cells(c.Row + 1, 1) 'symbol .Cells(r, "f") = Cells(c.Row + 1, 2) 'startdate .Cells(r, "g") = Cells(firstvaluerow, "B") 'enddate .Cells(r, "h") = Cells(firstvaluerow, "P") 'endvalue End With r = r + 1 End If Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstAddress End If End With Application.ScreenUpdating = True End Sub -- Don Guillett Microsoft MVP Excel SalesAid Software "Don Guillett" wrote in message ... If desired, send your file to my address below. I will only look if: 1. You send a copy of this message on an inserted sheet 2. You give me the newsgroup and the subject line 3. You send a clear explanation of what you want 4. You send before/after examples and expected results. -- Don Guillett Microsoft MVP Excel SalesAid Software "John Yab" wrote in message ... Would someone please help me with a macro? I have data on a sheet that I am trying to selectively move to a summary sheet; below is an example: Revenue Net $1,296.00 $24.00 Revenue Net $964.00 ($28.00) Revenue Net $416.00 ($40.00) $416.00 ($40.00) $416.00 ($40.00) There are blocks of data on a sheet. Each block has a different number of rows. Each block is seperated by one blank row. In column P is the heading "Net" in each block. Under "Net" can be blanks or a dollar amount or the blank between blocks of data or a new heading of "Net" for a new block of data. I am trying to move the dollar amount to a summary sheet. Sometimes there is more than one dollar amount in each block... I only want the first instance of the dollar amount then I need to skip to the next block and get the first instance of the dollar amount in that next block. Sometimes there is no dollar amount and then I would have to skip to the next block of data. When/if I find the dollar amount I need to copy and paste it to the summary sheet and also copy and past the values in that same row from column A (an ID) and column B (the end date). The value 2nd from the top of the column B in that block of data is the "start" date. I need to capture the start date too and move it to the summary sheet. In summary the macro would grab 4 bits of data and move it to the summary sheet and then move on to the next block of data a grab and move 4 bits of data from that block, etc. I have been working hard with loops and cases and if's for a week and can't quite get it so any help is very appreciated with big thanks. -- John Yab . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Moving Selected Fields to Summary Sheet | Excel Discussion (Misc queries) | |||
Generate sheet names from list, assign data to summary sheet. | Excel Programming | |||
How can i copy data from a tabbed working sheet to a summary sheet | Excel Discussion (Misc queries) | |||
Multiple sheet data summary | Excel Worksheet Functions | |||
selectively copying ranges from one sheet to second sheet | Excel Programming |