Code works in one file and not in another

[Belleke]

Included 3 files
1 file called doel (target) works
1 File called Bron (source)
1 File called Representatief voorbeeld (representative example) does not work
In the file target and representative example I am using exact the same code but in the file representative example the code does not work and i cannot find out why.
Please advice
Thanks in advance

 

[PCosta87]

Hi @Belleke

Having a hard time understanding the problem
In file Doel (Target) there is no code but you say it is working?
Then, the file Bron (source) has code.

Could you please explain what you wish to accomplish with the code in both cases?

Thks
Regards

 

[Belleke]

Sorry PCosta, my mistake, I mean Bron (Source)
For both files Bron and Representatve example.
I there is for example the word "test" in Colum B then the rows
Were the word "test is in should be copyed (colum B and Column N only) to Sheet Doel (or a completely new sheet) in colum A & B
Thank you for your quick reply, i hope it is a bit clearer now

 

[PCosta87]

@Belleke

When using "Cells(1).CurrentRegion" you are only going to search the first 3 rows because you have only empty cells in row 4

Just delete 4th row or make sure there is at least one cell not blank in that row and you should be good to go
The same goes for any row in the entire table... for instance, if you clear the contents of row 24, "test" will not be found because you will only be looking fot it up to row 23.

Regards

 

[Belleke]

Thank you my friend
It works like a charm
Do you have some code in your excel cabinet to add a new workbook instead of using the sheet Doel.

 

[PCosta87]

Thank you my friend
It works like a charm
Do you have some code in your excel cabinet to add a new workbook instead of using the sheet Doel.

sure

Replace

Workbooks("Doel").Sheets("Blad1").Cells(2, 1).Resize(UBound(ar1) + 1, UBound(ar1, 2) + 1) = ar1

with

    Dim NewWorkbook As Workbook
    Dim NewWorkbookName As String
 
    NewWorkbookName = InputBox("Insert file name", "New Workbook")
 
    
    If NewWorkbookName = vbNullString Then
        Exit Sub
    End If

    Set NewWorkbook = Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=NewWorkbookName
 
    Workbooks(NewWorkbookName).Sheets(1).Cells(2, 1).Resize(UBound(ar1) + 1, UBound(ar1, 2) + 1) = ar1

(Edit: added some code for when user hits cancel or doesn't provide name)

Regards

 

[Belleke]

Thank you again my friend
You are realy a excelent teacher
Have a nice evening.

 

[PCosta87]

Thank you again my friend
You are realy a excelent teacher
Have a nice evening.

Don't mention it

Have a good evening

 

[Belleke]

Sorry but i have another question
I am trying a bit of code to save the new worksheet in the same location as the one where the code is in, but I get an error
Any suggestions?

Private Sub CommandButton1_Click()
Dim ar, ar1, j As Long, t As Long
Dim NewWorkbook As Workbook
Dim NewWorkbookName As String
Dim thisWb As Workbook
ar = Sheets("Invulblad").Cells(1).CurrentRegion
ReDim ar1(UBound(ar), 3)
For j = 2 To UBound(ar)
    If ar(j, 2) = "Aseptisch_handen_LAF_kast_A" Then
        ar1(t, 0) = ar(j, 2)
        ar1(t, 1) = ar(j, 14)
        t = t + 1
    End If
Next j
Set thisWb = ActiveWorkbook
NewWorkbookName = InputBox("Geef het nieuwe bestand een naam!", "Nieuw bestand")
If NewWorkbookName = vbNullString Then
Exit Sub
End If

Set NewWorkbook = Workbooks.Add
Workbooks(NewWorkbookName).Sheets(1).Cells(2, 1).Resize(UBound(ar1) + 1, UBound(ar1, 2) + 1) = ar1
ActiveWorkbook.SaveAs Filename:=thisWb.Path & "\NewWorkbookName"
End Sub

Thanks

 

[Belleke]

Hello, I found the solution

Set thisWb = ActiveWorkbook
NewWorkbookName = InputBox("Geef het nieuwe bestand een naam!", "Nieuw bestand")
If NewWorkbookName = vbNullString Then
Exit Sub
End If
Set NewWorkbook = Workbooks.Add
relativePath = ThisWorkbook.Path & "\" & NewWorkbookName
ActiveWorkbook.SaveAs Filename:=relativePath
Workbooks(NewWorkbookName).Sheets(1).Cells(2, 1).Resize(UBound(ar1) + 1, UBound(ar1, 2) + 1) = ar1

Good evening

 

[PCosta87]

@Belleke

Sorry for the late response... seems you got it , great

Let me know if there is anything else I can help with.

Regards

 

[Belleke]

Hello,

Let me know if there is anything else I can help with.

Great, thank you