Consulting

Results 1 to 11 of 11

Thread: Solved: copying data error

  1. #1
    VBAX Regular
    Joined
    Nov 2007
    Posts
    24
    Location

    Solved: copying data error

    I am beginner with visual basic or any code for that matter, so bare with me if my question(s) dont make any sense or are just stupid!! sorrry in advance.

    but any help would be greatly appreciated.

    I am trying to scan through some data and copy certain lines over to a new work book. I got it working but it doesn't seem to be working correctly 100%

    It is suppose to scan through column 1 and recognize a ";" and the number "25" as the first character(s), and if it finds one, copy each row containing those characters to a seperate workbook.

    It does just that, but it seems to copy the same row every time it finds a semicolon or a 25.

    here is the code i have:

    [VBA]Sub PnP_Column1_FindSemiColon()

    Dim oWB1 As Workbook ' input worksheet
    Dim oWB2 As Workbook ' output worksheet

    Dim bRet As Boolean
    Dim cRet As Boolean

    Set oWB1 = ActiveWorkbook
    Set oWB2 = Workbooks.Add

    Dim i1 As Long
    Dim i2 As Long

    Dim arSemiColonAdd() As String
    Dim arFindNo25Add() As String
    Dim iRow

    bRet = FindAll(";", oWB1.Sheets(1), "A:A", arSemiColonAdd)
    cRet = FindAll("25", oWB1.Sheets(1), "A:A", arFindNo25Add)

    i2 = 1
    If bRet = True Then

    For i1 = 1 To UBound(arSemiColonAdd)
    i2 = i2 + 1
    iRow = Right(arSemiColonAdd(i1), Len(arSemiColonAdd(i1)) - InStrRev(arSemiColonAdd(i1), "$"))
    oWB1.Sheets(1).Rows(iRow).EntireRow.Copy Destination:=oWB2.Sheets(1).Range("A" & i2)
    Next i1

    End If

    If cRet = True Then

    For il = 1 To UBound(arFindNo25Add)
    i2 = i2 + 1
    iRow = Right(arFindNo25Add(i1), Len(arFindNo25Add(i1)) - InStrRev(arFindNo25Add(i1), "$"))
    oWB1.Sheets(1).Rows(iRow).EntireRow.Copy Destination:=oWB2.Sheets(1).Range("A" & i2)
    Next il


    End If
    End Sub[/VBA]

    The FindAll function (a sub-routine i have) seems to be doing its job, just it just seems to duplicate the rows it finds when they should all be somewhat different.

    as in:


    25 1 270 0.45 1.527 J1 WM7676
    25 1 90 1.8 0.974 J2 WM7676
    25 1 270 2.7 1.527 J3 WM7676
    25 1 90 4.05 0.974 J4 WM7676
    25 1 270 4.95 1.527 J5 WM7676
    25 1 90 6.3 0.974 J6 WM7676
    25 1 270 7.2 1.527 J7 WM7676
    25 1 90 8.55 0.974 J8 WM7676 <--copies this row only for some reason

    but instead i get:

    25 1 90 8.55 0.974 J8 WM7676
    25 1 90 8.55 0.974 J8 WM7676
    25 1 90 8.55 0.974 J8 WM7676
    25 1 90 8.55 0.974 J8 WM7676
    25 1 90 8.55 0.974 J8 WM7676
    25 1 90 8.55 0.974 J8 WM7676
    25 1 90 8.55 0.974 J8 WM7676
    25 1 90 8.55 0.974 J8 WM7676
    25 1 90 8.55 0.974 J8 WM7676


    can anyone see the problem??

    Thanks

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,446
    Location
    Where is the semi-colon in that data?

    What is FindAll?

    How about just posting the workbook?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Regular
    Joined
    Nov 2007
    Posts
    24
    Location
    Quote Originally Posted by xld
    Where is the semi-colon in that data?

    What is FindAll?

    How about just posting the workbook?
    The semi-colon is the first character in some of the rows of the workbook indicating a comment.

    FindAll is a routine that a friend wrote up, and can be found here....

    [VBA]' FindAll function
    Function FindAll(ByVal sText As String, ByRef oSht As Worksheet, ByRef sRange As String, ByRef arMatches() As String) As Boolean
    ' --------------------------------------------------------------------------------------------------------------
    ' FindAll - To find all instances of the1 given string and return the row numbers.
    ' If there are not any matches the function will return false
    ' --------------------------------------------------------------------------------------------------------------
    On Error GoTo Err_Trap
    Dim rFnd As Range ' Range Object
    Dim iArr As Integer ' Counter for Array
    Dim rFirstAddress ' Address of the First Find
    ' -----------------
    ' Clear the Array
    ' -----------------
    Erase arMatches
    Set rFnd = oSht.Range(sRange).Find(What:=sText, LookIn:=xlValues, LookAt:=xlPart)
    If Not rFnd Is Nothing Then
    rFirstAddress = rFnd.Address
    Do Until rFnd Is Nothing
    iArr = iArr + 1
    ReDim Preserve arMatches(iArr)
    arMatches(iArr) = rFnd.Address ' rFnd.Row ' Store the Row where the text is found
    Set rFnd = oSht.Range(sRange).FindNext(rFnd)
    If rFnd.Address = rFirstAddress Then Exit Do ' Do not allow wrapped search
    Loop
    FindAll = True
    Else
    ' ----------------------
    ' No Value is Found
    ' ----------------------
    FindAll = False
    End If

    ' -----------------------
    ' Error Handling
    ' -----------------------
    Err_Trap:
    If Err <> 0 Then
    MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All"
    Err.Clear
    FindAll = False
    End If
    Exit Function
    End Function[/VBA]

  4. #4
    VBAX Regular
    Joined
    Nov 2007
    Posts
    24
    Location
    i am trying to figure out how to post the workbook so it is legible.....

    the way i tried it, it came out all screwed up! please be patient

  5. #5
    VBAX Master Norie's Avatar
    Joined
    Jan 2005
    Location
    Stirling, Scotland
    Posts
    1,831
    Location
    I don't see any semi-colons in the data you posted.

  6. #6
    VBAX Regular
    Joined
    Nov 2007
    Posts
    24
    Location
    i havent posted data....what you are looking at is the FindAll function.

    im working on posting the data now!!
    Last edited by kwik10z; 11-09-2007 at 08:22 AM.

  7. #7
    VBAX Regular
    Joined
    Nov 2007
    Posts
    24
    Location
    Attachment 7245

    can you get that?

    notice the semi-colon and the number 25 are in column 1 of the datasheet. I need the macro to scan each row in column 1 and if it notices one of them two values (; and 25) copy each and every line that contains those values to a seperate workbook/worksheet.

    It sort of does that now, but it seems to the copy the same line every time!

  8. #8
    VBAX Regular
    Joined
    Nov 2007
    Posts
    24
    Location
    please?? anyone?

  9. #9
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,446
    Location
    That code is far too obscure for me to work thtrough.

    Try this

    [vba]

    Public Sub Test()
    Dim rng As Range
    Dim LastRow As Long
    Dim oWB As Workbook

    With ActiveSheet

    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    Set oWB = Workbooks.Add
    Set rng = .Range("A1").Resize(LastRow)
    rng.AutoFilter field:=1, Criteria1:="=;*", Operator:=xlOr, Criteria2:=25
    rng.SpecialCells(xlCellTypeVisible).EntireRow.Copy oWB.Worksheets(1).Range("A1")
    oWB.Worksheets(1).Columns.AutoFit
    rng.AutoFilter

    Set rng = Nothing
    End With
    End Sub
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  10. #10
    VBAX Regular
    Joined
    Nov 2007
    Posts
    24
    Location
    Quote Originally Posted by xld
    That code is far too obscure for me to work thtrough.

    Try this

    [vba]

    Public Sub Test()
    Dim rng As Range
    Dim LastRow As Long
    Dim oWB As Workbook

    With ActiveSheet

    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    Set oWB = Workbooks.Add
    Set rng = .Range("A1").Resize(LastRow)
    rng.AutoFilter field:=1, Criteria1:="=;*", Operator:=xlOr, Criteria2:=25
    rng.SpecialCells(xlCellTypeVisible).EntireRow.Copy oWB.Worksheets(1).Range("A1")
    oWB.Worksheets(1).Columns.AutoFit
    rng.AutoFilter

    Set rng = Nothing
    End With
    End Sub
    [/vba]

    *Edit* I tried it, and it seems to do the job! thanks a ton man, your the man!

    There are a few more steps that i need to complete to finish my project completely, if i came back with more questions, would you mind helping me out?

  11. #11
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,446
    Location
    Of course not, that is what the forum is for.

    Might be best to start a new thread for you next question and mark this as solved.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •