Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Discussion (Misc queries) > VBA Code Help - Moved from an older topic
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 410
Default 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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 410
Default VBA Code Help - Moved from an older topic
On Jan 10, 7:40*am, jlclyde wrote:
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

* *copy1.Range(Range("J1"), Range("J" & rCount)) = department
* *copy1.Range(Range("K1"), Range("J" & rCount)) = empname
End Sub

copy1.Range(copy1.Range("J1"), copy1.Range("J" & rCount)) = department
copy1.Range(copy1.Range("K1"), copy1.Range("J" & rCount)) = empname

After I was ready to throw the computer out the window, i actually
read my code and realized that I had not specified the sheet to use
for each of the ranges. Since I had not activated any sheets it
assumed the one that it starts on was the right one. Silly me.
Thanks,
Jay
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 35,218
Default VBA Code Help - Moved from an older topic
These 2 lines?

copy1.Range(Range("J1"), Range("J" & rCount)) = department
copy1.Range(Range("K1"), Range("K" & rCount)) = empname

The range("J1") and range("J" & rcount) are both unqualified. Depending on
where the code is, they could refer to the activesheet (code is in a general
module) or they could refer to the sheet that owns the code (code behind a
worksheet).

So you have a few choices--but all depend on you qualifying the ranges:

copy1.Range(copy1.Range("J1"), copy1.Range("J" & rCount)) = department
copy1.Range(copy1.Range("K1"), copy1.Range("K" & rCount)) = empname

or

with copy1
.Range(.Range("J1"), .Range("J" & rCount)) = department
.Range(.Range("K1"), .Range("k" & rCount)) = empname
end with

The dots in front of those range objects mean they belong to the object in the
previous With statement -- in this case the copy1 worksheet.

or the one I'd use:

copy1.Range("J1:J" & rcount) = department
copy1.Range("K1:K" & rCount)) = empname



jlclyde wrote:

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

--

Dave Peterson
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 410
Default VBA Code Help - Moved from an older topic
On Jan 10, 9:18*am, Dave Peterson wrote:
These 2 lines?

* *copy1.Range(Range("J1"), Range("J" & rCount)) = department
* *copy1.Range(Range("K1"), Range("K" & rCount)) = empname

The range("J1") and range("J" & rcount) are both unqualified. *Depending on
where the code is, they could refer to the activesheet (code is in a general
module) or they could refer to the sheet that owns the code (code behind a
worksheet).

So you have a few choices--but all depend on you qualifying the ranges:

* *copy1.Range(copy1.Range("J1"), copy1.Range("J" & rCount)) = department
* *copy1.Range(copy1.Range("K1"), copy1.Range("K" & rCount)) = empname

or

* *with copy1
* * * .Range(.Range("J1"), .Range("J" & rCount)) = department
* * * .Range(.Range("K1"), .Range("k" & rCount)) = empname
* *end with

The dots in front of those range objects mean they belong to the object in the
previous With statement -- in this case the copy1 worksheet.

or the one I'd use:

* *copy1.Range("J1:J" & rcount) = department
* *copy1.Range("K1:K" & rCount)) = empname





jlclyde wrote:

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

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Thanks for that Dave. I will keep thqat in mond for later code.
Jay
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

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
How is a a help topic example selected? Ken Excel Discussion (Misc queries) 1 January 10th 07 10:42 PM
Topic did not show up? Jason Sands Excel Worksheet Functions 3 October 28th 06 07:19 PM
example in the help topic Lois Ann New Users to Excel 4 August 2nd 06 12:16 AM
Where do I find the help topic Roberto Excel Discussion (Misc queries) 2 July 5th 05 03:21 PM
Off Topic Messages Alan Excel Worksheet Functions 1 November 21st 04 10:00 PM


All times are GMT +1. The time now is 02:14 AM.

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

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement