Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
A visual basic value copy BUG?? - accounting format has copy problem!! | Excel Programming | |||
Copy/Paste how to avoid the copy of formula cells w/o calc values | Excel Discussion (Misc queries) | |||
copy formulas from a contiguous range to a safe place and copy them back later | Excel Programming | |||
EXCEL FILE a copy/a copy/a copy ....filename | New Users to Excel | |||
How copy format, font, color and border without copy/paste? | Excel Programming |