Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
VBA Code Help - Moved from an older topic
Below is the code that i have been slowly adding to to accomplish a
task of moving all of this information to another sheet. The two sheets that I have are RA and inspect form and copysheet. The code runs great until the last two lines. I can not figure out why it is throwing an error. Thanks, Jay Sub addsheet() Dim form As Worksheet Dim copy1 As Worksheet Dim NextRow As Long Dim rCount As Integer Sheets.Add Type:="Worksheet" With ActiveSheet .Move After:=Worksheets(Worksheets.Count) .Name = "copysheet" End With Set form = Sheets("RA and inspect Form") NextRow = form.Range("A10").End(xlDown).Row Set copy1 = Sheets("copysheet") form.Range("A10").Resize(NextRow - 9, 8).copy copy1.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False copy1.Cells.Sort _ Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _ Key2:=Range("F1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal rowCount = 1 Do While Range("A" & rowCount) < "" And Range("F" & rowCount) < "" If Range("B" & rowCount) = Range("B" & (rowCount + 1)) _ And Range("F" & rowCount) = Range("F" & (rowCount + 1)) Then Data = Range("A" & (rowCount + 1)) Data2 = Range("B" & (rowCount + 1)) Data3 = Range("C" & (rowCount + 1)) Data4 = Range("D" & (rowCount + 1)) Data5 = Range("E" & (rowCount + 1)) Data6 = Range("F" & (rowCount + 1)) If Range("A" & rowCount) = "" And Range("F" & rowCount) = "" Then Range("A" & rowCount) = Data Range("B" & rowCount) = Data2 Range("C" & rowCount) = Data3 Range("D" & rowCount) = Data4 Range("E" & rowCount) = Data5 Range("F" & rowCount) = Data6 Else Range("A" & rowCount) = Range("A" & rowCount) & ", " & Data Range("B" & rowCount) = Range("B" & rowCount) Range("C" & rowCount) = Range("C" & rowCount) & ", " & Data3 Range("D" & rowCount) = Range("D" & rowCount) & ", " & Data4 Range("E" & rowCount) = Range("E" & rowCount) + Data5 Range("F" & rowCount) = Range("F" & rowCount) End If Rows(rowCount + 1).Delete Else rowCount = rowCount + 1 End If Loop copy1.Range("A:A").Cut copy1.Range("H:H") copy1.Range("F:F").Cut copy1.Range("I:I") copy1.Range("B:B").Cut copy1.Range("O:O") copy1.Range("E:E").Cut copy1.Range("Q:Q") copy1.Range("C:C").Cut copy1.Range("F:F") copy1.Range("D:D").Cut copy1.Range("G:G") rCount = copy1.UsedRange.Rows.Count Range(Range("A1"), Range("A" & rCount)).NumberFormat = "mm/dd/ yyyy" Range(Range("A1"), Range("A" & rCount)) = form.Range("B1") Range(Range("C1"), Range("C" & rCount)) = form.Range("B2") Range(Range("L1"), Range("L" & rCount)) = form.Range("G2") Range(Range("M1"), Range("M" & rCount)) = form.Range("B5") Range(Range("N1"), Range("N" & rCount)) = form.Range("B7") Dim rFound As Range With Sheets("RA and inspect form") Set rFound = .Columns(1).Find(What:="Inspection Notes", _ After:=.Cells(1, 1), LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, _ SearchFormat:=False) If Not rFound Is Nothing Then .Activate End If End With Dim department, empname As Range Set department = rFound.Offset(27, 1) Set empname = rFound.Offset(27, 2) copy1.Range(Range("J1"), Range("J" & rCount)) = department copy1.Range(Range("K1"), Range("J" & rCount)) = empname End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How is a a help topic example selected? | Excel Discussion (Misc queries) | |||
Topic did not show up? | Excel Worksheet Functions | |||
example in the help topic | New Users to Excel | |||
Where do I find the help topic | Excel Discussion (Misc queries) | |||
Off Topic Messages | Excel Worksheet Functions |