I copy cells (from sheet1) if they contain a specific value (got this part figured out).
I need to paste them in a cell on sheet2 in row j.
Sheet1 has a long list of names, companies, emails, phones etc. with each person's information separated by a space. For Ex:
Column A Column B
Smith, Jill #N/A
CEO #N/A
ABC Corp 123 street ABC Corp
jill@ABC.com #N/A
#N/A
Smith, John #N/A
CTO #N/A
123 Inc ABC street 123 Inc
john@123.com #N/A
I have a variable (j) that counts each space and then if Cell b does not equal #NA, then cell a is copied and pasted into sheet2 column M and row j.
Variable j is needed because the formula in column B isn't 100% and the data is inconsistent so I need j so that the company name stays on the same line as the name. I need this because I have other code to split column A (like 4000 rows) into separate sheets by names, titles, companies, emails.
Ie Sheet3 would have:
1. Jill Smith
2. John Smith
Sub AutoCompany()
Application.ScreenUpdating = False
Dim lr As Long, tr As Long, i As Long, j As Long, k As Long
Worksheets("Sheet1").Activate
lr = Range("A" & Rows.Count).End(xlUp).Row
tr = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row - 1
'this is my formula for column B
Range("B2:B" & lr).Formula = "=INDEX(CompaniesTbl[CompanyNamesList],IF(SUMPRODUCT(--ISNUMBER(SEARCH(CompaniesTbl[CompanyNamesList],A2)))<>0,SUMPRODUCT(--ISNUMBER(SEARCH(CompaniesTbl[CompanyNamesList],A2))*ROW($1:$" & tr & ")),NA()))"
j = 0
k = 1
For i = 2 To lr Step 1
'increase j by 1 if there is a blank space (to figure out where to paste)
If Cells(i, 1) = "" Then
j = j + 1
'extra variable just cause
k = k + 1
End If
'check for an actual value
If Application.IsNA(Cells(i, 2)) Then
Else
Worksheets("Sheet1").Cells(i, 2).Select
Selection.Copy
Worksheets("Company").Activate
Worksheets("Company").Range("M" & j).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet1").Activate
End If
Next
Application.ScreenUpdating = True
End Sub
This causes an error
"object defined or variable defined"
If I remove j from my paste selection, the error is gone but all my pastes are overwritten.
I can't remember what I had done before, but I basically didn't have all of the sheet activations and that caused a out of range error. Which I fix by activating a sheet, but that causes my variable to cause an error.
Edit:
Based on the comments and answer, the issue is not in how the VBA is written per se. I think it has to do with the fact that the variable j is unable to be called in the if statement. I can't figure another way to do this or how to troubleshoot that issue.
From deciphering your code I assume that you what to copy the company names from column B to Worksheets("Company")
column M, starting on the first row.
Dim cel As Range, j As Long 'assign your variables
With ThisWorkbook.Sheets("Sheet1") 'use "With" so you don't have to activate your worksheets
j = 1
For Each cel In .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row) 'loop through each cell in range
If Application.IsNA(cel) Then 'test for error and skip
ElseIf cel.Value = "" Then 'test for blank cell and skip
'It is better to set a cells value equal to another cells value then using copy/paste.
Else: ThisWorkbook.Sheets("Company").Cells(j, "M").Value = cel.Value
j = j + 1 'add 1 to j to paste on the next row
End If
Next cel
End With
Check my code's comments and adjust it to fit your needs
Option Explicit ' -> Always use this at the top of your modules and classes
' Define your procedures as public or private
' Indent your code (I use RubberDuck (http://rubberduckvba.com/) which is a great piece of software!
Public Sub AutoCompany()
On Error GoTo CleanFail
Application.ScreenUpdating = False ' This should be used with an error handler see https://rubberduckvba.wordpress.com/tag/error-handling/
' Declare object variables
Dim sourceSheet As Worksheet
Dim lookupSheet As Worksheet
Dim resultsSheet As Worksheet
Dim sourceRange As Range
Dim evalCell As Range
' Declare other variables
Dim sourceSheetName As String
Dim lookupSheetName As String
Dim resultsSheetName As String
Dim sourceLastRow As Long
Dim lookupLastRow As Long
' Initialize variables
sourceSheetName = "Sheet1"
lookupSheetName = "Sheet2"
resultsSheetName = "Company"
' Initialize objects
Set sourceSheet = ThisWorkbook.Worksheets(sourceSheetName) ' This could be replaced by using the sheet's codename see https://www.spreadsheet1.com/vba-codenames.html
Set lookupSheet = ThisWorkbook.Worksheets(lookupSheetName) ' Same as previous comment
Set resultsSheet = ThisWorkbook.Worksheets(resultsSheetName) ' Same as previous comment
' Worksheets("Sheet1").Activate -> Not needed
sourceLastRow = sourceSheet.Range("A" & Rows.Count).End(xlUp).Row ' This is unreliable -> see https://stackoverflow.com/a/49971492/1521579
lookupLastRow = lookupSheet.Range("A" & Rows.Count).End(xlUp).Row - 1 ' Couldn't understand why you subtract 1
' Define the sourceRange so we can loop through the cells
Set sourceRange = sourceSheet.Range("A2:A" & sourceLastRow)
' this is my formula for column B -> Comments should tell why you do something not what you're doing
sourceSheet.Range("B2:B" & sourceLastRow).Formula = "=INDEX(CompaniesTbl[CompanyNamesList],IF(SUMPRODUCT(--ISNUMBER(SEARCH(CompaniesTbl[CompanyNamesList],A2)))<>0,SUMPRODUCT(--ISNUMBER(SEARCH(CompaniesTbl[CompanyNamesList],A2))*ROW($1:$" & lookupLastRow & ")),NA()))"
' Begin the loop to search for matching results
For Each evalCell In sourceRange
' Skip cells that are empty
If evalCell.Value <> vbNullString Then
' Check value in column B (offset = 1 refers to one column after current cell and using not before application.IsNA checks for is found)
If Not Application.WorksheetFunction.IsNA(evalCell.Offset(rowOffset:=0, ColumnOffset:=1).Value) Then
' We use current evaluated cell row in the results sheet
resultsSheet.Range("M" & evalCell.Row).Value = evalCell.Value
End If
End If
Next evalCell
CleanExit:
Application.ScreenUpdating = True
Exit Sub
CleanFail:
Debug.Print "Catched an err: " & Err.Description & " ... do something!"
Resume CleanExit
End Sub
Let me know if it works and remember to mark the answer if it does
Thanks to everyone that tried helping. I found the problem. My J variable was set to 0 and so the first time the code ran, it tried pasting to cell 0 which is out of scope of the worksheet. The reason why I had set my variable to 0 was because I assumed the first empty row that it finds (above the dataset) would set the variable to 1 but that was not the case. Anyways, I set J to 1 and it worked... D'oh
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.