Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 72
Default Copy doesn't copy in Sub Extr10L

The code below is intended to get data from wsCtyData, the active
sheet when the macro is run, starting where the user indicates in the
userform, to another worksheet in the same workbook that the code
creates, wsTop. Where the data is supposed to be copied to is
referenced in a separate table in ThisWorkbook with the macro. The
macro runs but the copy command isn't copying. I've checked all the
variables to see that they are the values I expect.

Option Explicit
Public bHdr As Boolean 'used
Public lTop As Long 'used
Public rFirstData As Range 'used
Public lLastCol As Long 'used
Public lNumbrCol As Long 'defined
Public lStrDif As Long 'used

Sub Extr10L()
Dim wbCtyData As Workbook 'used
Dim oWS As Object 'used
Dim wsTop10List As Worksheet 'used
Dim wsCtyData As Worksheet 'used
Dim lFirstDataRow As Long 'defined
Dim lHdrRow As Long
Dim lFirstDataCol As Long 'used
Dim wsTop As Worksheet 'used
Dim rCtyDataHdr As Range 'used
Dim l10Row As Long 'used (Is this and subsequent
variable dupes w/ lArea1FirstRow & lArea2FirstRow?)
Dim lBOSRow As Long 'used
Dim rCtySrch As Range 'used
Dim rFndCell As Range 'used
Dim rCell As Range 'used
Dim rCtyData As Range 'used
Dim rFirstCtyDataCell As Range 'used
Dim sCtyDataCell As String 'used
Dim lCtyDataRow As Long

Set wsTop10List = ThisWorkbook.Worksheets("CtyLst")
Set wsCtyData = ActiveSheet
Set wbCtyData = ActiveWorkbook
Set rCtySrch = wsTop10List.Range("A2:A64")



'Test is Mark Top 10 workbook is active
If ActiveWorkbook.Name = ThisWorkbook.Name Then
MsgBox "You have selected the workbook that contains the macro." &
_
Chr(13) & "Please click Ok and select the correct workbook and " &
_
Chr(13) & "worksheet and restart the macro.", vbOKOnly
Exit Sub
End If

'TEST for existing sheet named "Top"
For Each oWS In wbCtyData.Sheets
If oWS.Name = "Top" Then
If MsgBox("A worksheet named Top already exists in this
workbook." _
& Chr(13) & "Please remove or rename it and run the macro
again.", _
vbOKOnly) = vbOK Then Exit Sub
End If

Next

lTop = 0
bHdr = False

uf1021Mid.Show

With rFirstData
lLastCol = .Columns(.Columns.Count).Column
rFirstData.Select
End With

lFirstDataRow = rFirstData.Row
lFirstDataCol = rFirstData.Column
Set rCtyData = Range(rFirstData, rFirstData.End(xlDown))


Set rCtyDataHdr = wsCtyData.Range(Cells(rFirstData.Row - 1,
lFirstDataCol), Cells(rFirstData.Row - 1, lLastCol))
' Create new ws "Top"
wbCtyData.Sheets.Add.Activate
ActiveSheet.Name = "Top"
Set wsTop = ActiveSheet

If bHdr = True Then

Select Case lTop
Case 10
wsTop.Activate
Range("A2") = "10 Large"
Range("A14") = "Balance of State"

rCtyDataHdr.Copy Destination:=wsTop.Range(Cells(3, 1), Cells(3,
lLastCol))
rCtyDataHdr.Copy Destination:=wsTop.Range(Cells(15, 1),
Cells(15, lLastCol))
l10Row = 4
lBOSRow = 16
End Select



Else
MsgBox "Wha 'appened?" 'TEMP until correct code done
End If

Set rFirstCtyDataCell = rCtyData.Range("a1")
lCtyDataRow = rFirstCtyDataCell.Row
sCtyDataCell = ""

For Each rCell In rCtySrch

wsCtyData.Activate

sCtyDataCell = Right(rCell.Value, Len(rCell.Value) - lStrDif)

Set rFndCell = rCtySrch.Find(What:=sCtyDataCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
MatchCase:=False)
If rFndCell Is Nothing Then
MsgBox "Cannot find Adams in county list. Check County list!"
Exit Sub
End If
If rFndCell.Offset(0, 1).Value = "x" Then
' MsgBox "rCtySrch = " & rCtySrch.Address
wsTop.Activate

rCtyData.Cells(lCtyDataRow, lFirstDataCol).Cells.Offset(0,
lLastCol) _
.Copy Destination:=wsTop.Range(Cells(l10Row, 1), Cells(l10Row,
lLastCol))
'NOTHING BEING COPIED

l10Row = l10Row + 1
lCtyDataRow = lCtyDataRow + 1

' Else
' rFirstData.Copy Destination:=wsTop.Range(Cells(lBOSRow, 1),
Cells(lBOSRow, lLastCol))

End If

Next
MsgBox "lCtyDataRow = " & lCtyDataRow

End Sub

Any suggestions?
Thanks!
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
A visual basic value copy BUG?? - accounting format has copy problem!! [email protected] Excel Programming 3 June 20th 06 04:42 PM
Copy/Paste how to avoid the copy of formula cells w/o calc values Dennis Excel Discussion (Misc queries) 10 March 2nd 06 10:47 PM
copy formulas from a contiguous range to a safe place and copy them back later Lucas Budlong Excel Programming 2 February 22nd 06 08:26 PM
EXCEL FILE a copy/a copy/a copy ....filename ve New Users to Excel 1 September 29th 05 09:12 PM
How copy format, font, color and border without copy/paste? Michel[_3_] Excel Programming 1 November 5th 03 04:43 PM


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

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"