rows contains certain text "?" in new document

[leewalker]

hi

i wonder if anyone can help me i have a spreadsheet with 12 columns

i am looking for a way in which i can search the whole spreadsheet row by row for "?" in the last columns and if found select the whole of the row and copy the whole row to a line of a spreadsheet of set name i require it to leave 1 row under each row it copies. until it get to the end of the spreadsheet around 4000+ lines.

as you can see if i was to do this manually would take hours upon hours.


i hope i have outlined my problem clearly if you have any more questions please do not hesitate to asked and i be happy to explain more best i can

i thank you all in advance.

 

[leewalker]

Try this small modification in your code:

Sub CopyRows()
    Dim bottomL As Long
    Dim x As Long
    Dim WBO, WBN As Workbook
    Dim mySheet1, mySheet2 As Worksheet
    Dim c As Range    
    Set WBO = ActiveWorkbook
    Set mySheet1 = WBO.Sheets("sheet1")
    Set WBN = Workbooks.Add(xlWBATWorksheet)
    Set mySheet2 = WBN.Worksheets(1)
    mySheet2.Name = "sheetcopieddata"
    bottomL = mySheet1.Range("L" & Rows.Count).End(xlUp).Row
    x = 2
    For Each c In mySheet1.Range("L1:L" & bottomL)
        If InStr(c.Value, "?") Then
            c.EntireRow.Copy mySheet2.Range("A" & x)
            x = x + 2
        End If
    Next c
    WBN.SaveAs "copieddata"
End Sub

Markmzz

hi Markmzz

thanks for your reply where would i change the location of "copiedata.xls" file

 

[markmzz]

hi Markmzz

thanks for your reply where would i change the location of "copiedata.xls" file

In this row of the code:

[B]WBN.SaveAs "copieddata"
[/B]
For example, for to save in the directory [B][COLOR=#ff0000]C:\Test [/COLOR][/B]try this code:

[B]WBN.SaveAs "C:\Test\copieddata"[/B]

Markmzz

 

[leewalker]

also got it working 100% just one slight problem i have found that there is a couple of the workbooks that have a smaller amound of colums it is possiable to get it to check last colum rather than giving a range/ cell reference eg "L1:L" it will always be the last colum

also is there anyway i have the following which allows me to choice which files it runs so i can do more than 1 document at a time.

Sub OpenFilesquery()
Dim Folderpath As String
Dim cell As Range
Dim r, LRow As Single
Dim CWB As Workbook

Folderpath = Range("B1").Value
Set CWB = ActiveWorkbook

If Right(Folderpath, 1) <> "\" Then
  Folderpath = Folderpath & "\"
End If

For Each chkbx In ActiveSheet.CheckBoxes
    If chkbx.Value = 1 Then
        For r = 1 To Rows.Count
            If Cells(r, 1).Top = chkbx.Top Then
                Workbooks.Open FileName:=Range("B" & r).Value
                Call querycheck
                Exit For
            End If
        Next r
        ActiveWorkbook.Close SaveChanges:=True
    End If
Next

End Sub

Sub querycheck()

    Dim bottomL As Long
    Dim x As Long
    Dim WBO, WBN As Workbook
    Dim mySheet1, mySheet2 As Worksheet
    Dim c As Range
    Set WBO = ActiveWorkbook
    Set mySheet1 = WBO.Sheets("sheet1")
    Set WBN = Workbooks.Add(xlWBATWorksheet)
    Set mySheet2 = WBN.Worksheets(1)
    mySheet2.Name = "sheetcopieddata"
    bottomL = mySheet1.Range("L" & Rows.Count).End(xlUp).Row
    x = 2
    For Each c In mySheet1.Range("L1:L" & bottomL)
        If InStr(c.Value, "?") Then
            c.EntireRow.Copy mySheet2.Range("A" & x)
            x = x + 2
        End If
    Next c
    WBN.SaveAs "I:\10 proposals and working documents\Linda\excel query col mov\copieddata.xlsx"
     
End Sub

i have looking for it each time it stats a new book to add the file name in its own row

for example the output would be like.

FILE NAME
COPIED Row One from file 1
BLANK ROW
COPIED Row One from file 12
BLANK ROW

FILE NAME 2
COPIED Row One from file 2
BLANK ROW
COPIED Row Two from file 2

hope i have made myself clear what i am looking to do.

 

[markmzz]

Try this small modification in your code:

Sub OpenFilesquery()
    Dim Folderpath As String
    Dim cell As Range
    Dim myi As Long
    Dim r, LastRow0 As Long
    Dim CWB, TWB, WBN As Workbook
    Dim mySheet0 As Worksheet
    
    Folderpath = Range("B1").Value
    Set CWB = ActiveWorkbook
    Set mySheet0 = CWB.Sheets("Main")
    LastRow0 = mySheet0.Cells(Rows.Count, 2).End(xlUp).Row
    If Right(Folderpath, 1) <> "\" Then
      Folderpath = Folderpath & "\"
    End If
    myi = 1
    For Each chkbx In ActiveSheet.CheckBoxes
        If chkbx.Value = 1 Then
            For r = 2 To LastRow0
                If Cells(r, 1).Top = chkbx.Top Then
                    Workbooks.Open Filename:=Folderpath & Range("B" & r).Value
                    Set TWB = ActiveWorkbook
                    CopyRows WBN, myi
                    myi = myi + 1
                    Exit For
                End If
            Next r
            WBN.Close SaveChanges:=True
            TWB.Close SaveChanges:=False
        End If
    Next
End Sub

Sub CopyRows(ByRef WBN As Workbook, myi As Long)
    Dim LastRow, LastCol As Long
    Dim x As Integer
    Dim WBO As Workbook
    Dim mySheet1, mySheet2 As Worksheet
    Dim c As Range
    
    Set WBO = ActiveWorkbook
    Set mySheet1 = Sheets("sheet1")
    Set WBN = Workbooks.Add(xlWBATWorksheet)
    Set mySheet2 = WBN.Worksheets(1)
    mySheet2.Name = "sheetcopieddata"
    LastRow = mySheet1.Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = mySheet1.Cells(1, Columns.Count).End(xlToLeft).Column
    x = 2
    For Each c In mySheet1.Range(Cells(1, LastCol).Address, Cells(LastRow, LastCol).Address)
        If InStr(c.Value, "?") Then
            c.EntireRow.Copy mySheet2.Range("A" & x)
            x = x + 2
        End If
    Next c
    'Stop
    WBN.SaveAs "C:\Test\Copieddata" & myi
End Sub

Markmzz

 

[leewalker]

i get run time error 9

subscript out of range when debug the highlighted line is Set mySheet0 = CWB.Sheets("Main")

do you have skype or can you PM me your email i will email over full testing files im using.

 

[markmzz]

i get run time error 9

subscript out of range when debug the highlighted line is Set mySheet0 = CWB.Sheets("Main")

do you have skype or can you PM me your email i will email over full testing files im using.

Main is the name of the sheet where you have the path, the names of the workbooks and the checkboxes. By the way, the Main sheet need to be in the workbook that have the code.

Markmzz

 

[leewalker]

i am now gettin runtime eror 1004 excel can not access file. it seems to be adding full file path twice.

would it be possiable to send you a copy of all my testing files i have via email or skype?

 

[leewalker]

i am was gettin runtime eror 1004 excel can not access file. it seems to be adding full file path twice. but have resolved this by adjusting

Workbooks.Open Filename:=Folderpath & Range("B" & r).Value to Workbooks.Open Filename:=Range("B" & r).Value

it now seem to be saving in more than one Copieddata file i require it all to save it one file but will the file name at top of list when starts new file.

how would i achive this.


would it be possiable to send you a copy of all my testing files i have via email or skype?

 

[markmzz]

Hi Leewalker,

Look at your PM Box.

Markmzz

 

[leewalker]

i have replied to PM