Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 391
Default 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

.

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Creating a Visual Basic Macro Clarence Excel Discussion (Misc queries) 1 March 24th 10 08:06 PM
Visual Basic Autoshapes Macro Dav Excel Discussion (Misc queries) 2 December 14th 05 05:33 PM
MS Visual Basic Error...from MAcro G118 Excel Discussion (Misc queries) 0 December 12th 05 05:56 PM
Macro Calling Visual Basic References phauenstein Excel Discussion (Misc queries) 1 August 24th 05 09:28 PM
Visual Basic Macro negzel Excel Discussion (Misc queries) 1 December 28th 04 10:53 PM


All times are GMT +1. The time now is 07:36 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"