Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

can someone chek my (little) code?

Status
Not open for further replies.

dorjee

Technical User
Feb 11, 2004
21
SE
hi!
Would it it be possible to examine my code and comment some errors that as a newcomer I missed?
The code should extract from sheet1 the rows that have a certain value on column 6. First I have to extract the value of reference, which is the max value on this column. Problem is that it is formatted as text so I try to format it as value first, and then extract the max value. Each entry of this column is then compared to this value of reference and the matching ones are extracted to sheet 3.

THanks for any comments
code:

Sub Find()
Dim dat As Integer, datold As Integer, x As Integer
Dim lRow As Long, lcol As Integer, i As Integer, refArr As Variant, CompArr As Variant
Dim refSht As Worksheet, compSht As Worksheet, incr As Long

Set refSht = Sheets("Sheet1")
Set compSht = Sheets("sheet2")
lRow = refSht.UsedRange.Rows.Count
lcol = refSht.UsedRange.Columns.Count
refSht.Select

'below is to format text data to numbers
refSht.Range("ff1") = 1
refSht.Range("FF1").Select
Selection.Copy
Columns("F:F").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False

'put the max value into reference
dat = Application.WorksheetFunction.Max(Range("f:f"))

Range("ff1") = ""


datold = dat - 7

refArr = refSht.Range(Cells(1, 6), Cells(lRow, 6))

For x = LBound(refArr) To UBound(refArr)
incr = 1
If refArr(x, 1) > datold Then

refSht.Range(Range(Cells(x, 1), Cells(x, lcol)).Address).Copy Destination:=Sheets("Sheet3").Range("A" & incr)
incr = incr + 1
End If

Next x

GetDiffs



End Sub
 
dorjee,

1. What does the data look like on Sheet1?

2. What does this code accomplish for you?
Code:
    'below is to format text data to numbers
    refSht.Range("ff1") = 1
    refSht.Range("FF1").Copy
    Columns("F:F").PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
    SkipBlanks:=False, Transpose:=False


Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884
 
skipvought,
My data on sheet1 is structured into 15 columns, and the format is text for all cells although some represent numbers. but the only column i have to test to extract rows is the value in the sixth column.

The code you highlighted is a code that I got from someone on the forum. Stupidly, I copied it without properly understanding it. It is (supposed) to reformat the text format in cells of column 6 from text to numbers. I need this to be able to get the max value in the column, which I then use to test all rows and decide if they are to extract(eg if the cell6 on row is the same as this max value, extract the whole row).
I don t know how to use the value function and max function embeded in vba.
I you had an idea it would be super.
thanks
 
You have already done a good job.

Comments within the code...
Code:
Sub Find()
    Dim dat As Integer, datold As Integer, x As Integer
    Dim lRow As Long, lcol As Integer, i As Integer, refArr As Variant, CompArr As Variant
    Dim lRowFirst As Long, lRowLast As Long
    Dim iColFirst As Integer, iColLast As Integer
    Dim refSht As Worksheet, incr As Long
    
    Set refSht = Sheets("Sheet1")
'there is really no reason to set a sheet object here since you are not manipulating a number so sheets
'could be done just as simple as...
    With Sheets("Sheet1")
        'all the code under With refSht
    End With
    
'here it is using refSht...
    With refSht
'    these definitions work when data does not start in row 1 AND/OR col 1
        With .UsedRange
            lRowFirst = .Row
            lRowLast = lRowFirst + .Rows.Count - 1
            iColFirst = .Column
            iColLast = iColFirst + .Columns.Count - 1
        End With
'    your definitions work AS LONG AS data starts in row 1 col 1
        lRow = .Rows.Count
        lcol = .Columns.Count
'    refSht.Select
    
    'below is to format text data to numbers
    'no need to use the select method -- this slows down processing
        .Range("ff1") = 1
        .Range("FF1").Copy
        Range(.Cells(lRowFirst, "F"), .Cells(lRowLast, "F")).PasteSpecial _
            Paste:=xlPasteAll, Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False
        
    'put the max value into reference
        dat = Application.WorksheetFunction.Max(.Range("f:f"))
    '.Clear is a better method than assigning a value of ""
        .Range("ff1").Clear
        
        datold = dat - 7
        
        refArr = Range(.Cells(lRowFirst, 6), .Cells(lRowLast, 6))
    
    'initialize incr OUTSIDE the loop
        incr = 1
    'refArr as 2 dimensions.  you can get the BOUNDS of both dimensions using _
        LBound(refArr, 1) and LBound(refArr, 2) , _
        the second of which would loop thru the columns (1 - 6)
        For x = LBound(refArr) To UBound(refArr)
            If refArr(x, 1) > datold Then
            
            Range(.Cells(x, 1), .Cells(x, lcol)).Copy _
                Destination:=Sheets("Sheet3").Cells(incr, "A")
            incr = incr + 1
            End If
            
        Next x
            
        GetDiffs
    End With
'set the worksheet object to NOTHING
    Set refSht = Nothing
End Sub


Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884
 
THANK YOU skipvought for your help!
I ll meditate on your information..
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top