Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
VBA code help
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 | |||
Drop Down/List w/Code and Definition, only code entered when selec | Excel Worksheet Functions | |||
Convert a Number Code to a Text Code | Excel Discussion (Misc queries) | |||
Unprotect Code Module in Code | Excel Discussion (Misc queries) | |||
copying vba code to a standard code module | Excel Discussion (Misc queries) | |||
Write a code by code | Excel Discussion (Misc queries) |