Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 410
Default 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
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
Drop Down/List w/Code and Definition, only code entered when selec Spiritdancer Excel Worksheet Functions 2 November 2nd 07 03:57 AM
Convert a Number Code to a Text Code Traye Excel Discussion (Misc queries) 3 April 6th 07 09:54 PM
Unprotect Code Module in Code Damien Excel Discussion (Misc queries) 2 April 18th 06 03:10 PM
copying vba code to a standard code module 1vagrowr Excel Discussion (Misc queries) 2 November 23rd 05 04:00 PM
Write a code by code Excel Discussion (Misc queries) 1 March 23rd 05 02:34 PM


All times are GMT +1. The time now is 04:52 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"