visual basic macro in excel
The question is not very clear. When you say insert
columns, it looks like you actually mean rows. The output doesn't seem to match the input. Are you saying that if a date appears where lpc-b has a value n, then that dat eshould appear n times? 1/1/92 has a value 5, and is already once in the results file, so add four more. 1/2/92 has a value 0, so its removed from the results file. dates in the result sfile that aren't in the source file, like 11/29/91 are left in situ. proposed methodology: For each date in the source file, count existing items, adding or removing as required Sub DateGrind() Dim wsSource As Worksheet Dim wsResults As Worksheet Dim SourceRow As Long ' row pointer for Source book Dim ResultRow As Long ' row pointer for Result book Dim count As Long ' for counting the dates Dim ThisDate As Date ' date to be tested Dim RequiredCount As Long ' lpc-b number ' point to the relevant sheets ' note the data is as per the question Set wsResults = Workbooks("Book2").ActiveSheet Set wsSource = Workbooks("Book1").ActiveSheet SourceRow = 2 ' row 1 is headers : date/lpc-b Do Until wsSource.Cells(SourceRow, 1).Value = "" ThisDate = wsSource.Cells(SourceRow, 1).Value RequiredCount = _ wsSource.Cells(SourceRow, 1).Offset(0, 1).Value count = 0 ResultRow = 1 Do Until wsResults.Cells(ResultRow, 1).Value = "" If wsResults.Cells(ResultRow, 1).Value = _ ThisDate Then count = count + 1 If count RequiredCount Then wsResults.Rows(ResultRow).Delete Else ResultRow = _ ResultRow + 1 End If Else ResultRow = ResultRow + 1 End If Loop Do While count < RequiredCount wsResults.Cells(ResultRow, 1).Value = ThisDate ResultRow = ResultRow + 1 count = count + 1 Loop SourceRow = SourceRow + 1 Loop End Sub Basically the outer loop refers to each date in the source. the first inner loop counts the matching dates - when the count exceeds the requirement, dates are removed. the second inner loop adds dates if the count is less than the requirement. tested ok Patrick Molloy Microsoft Excel MVP -----Original Message----- file: testsource.exl date lpc-b 1/1/1992 5 1/2/1992 0 1/3/1992 1 1/4/1992 4 file:testresult.exl date 11/29/1991 12/24/1992 1/1/1992 1/2/1992 1/3/1992 1/4/1992 1/5/1992 1/6/1992 I am trying to use the lpc-b dat in testsource.exl to expand the date column in testresult.excel, inserting blank columns and then filling down so the number of date entries equals the lpc-b value. final spreadsheet should look like this: file:testresult.exl date 11/29/1991 12/24/1992 1/1/1992 1/1/1992 1/1/1992 1/1/1992 1/1/1992 1/3/1992 1/4/1992 1/4/1992 1/4/1992 1/4/1992 1/5/1992 1/6/1992 I found that when I record a macro, the operations of moving one column down and dragging down to select a range of cells don't seem to be recognized and, indeed, when I try to modify the macro to do this I get error messages about procedures not being supported. Is it possible to fix the following code, or is it not possible to do using variable names. Commented code follows: Sub Macro1() ' ' Macro1 Macro ' Macro recorded 7/22/03 by Thomas L. Wright ' ' Workbooks.Open FileName:= _ "Macintosh HD:TLW/RSF kilauea book:tilt/seismicity:tilt/seismicity.excel:eq count/tremor:testsource.exl" Workbooks.Open FileName:= _ "Macintosh HD:TLW/RSF kilauea book:tilt/seismicity:tilt/seismicity.excel:eq count/tremor:testresult.exl" Windows("testsource.exl").Activate Range("d2").Select Selection.Copy eqctnum = Selection Range("A2").Select Selection.Copy sourcedate = Selection Windows("testresult.exl").Activate Columns("A:A").Select Selection.Find(What:=sourcedate, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False).Activate ActiveCell.Select Code works to here, including use of variable for date now when I try to move down one cell, select that cell and the three below it, no command, wuch as cell.offset, seems to work Selection.Insert Shift:=xlDown This line works Windows("testsource.exl").Activate The rest of the code uses explicit ranges, which I cannot specify without using the variable "eqctnum". Range("A3").Select Application.CutCopyMode = False Selection.Copy Windows("testresult.exl").Activate Columns("A:A").Select Selection.Find(What:="1/2/1992", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False).Activate Application.CutCopyMode = False Range("A9").Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp Windows("testsource.exl").Activate Range("A5").Select Windows("testresult.exl").Activate Columns("A:A").Select Selection.Find(What:="1/4/1992", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False).Activate Range("A11:A13").Select Selection.Insert Shift:=xlDown Range("A10:A13").Select Selection.FillDown Range("B9").Select ActiveWorkbook.Save ActiveWindow.Close Range("B4").Select ActiveWorkbook.Save ActiveWindow.Close End Sub . |
All times are GMT +1. The time now is 03:09 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com