I'm having this code which perfectly work for me on Multiple result. My issue with this is when I got a single result this codes will still insert one space, I was hoping someone could help with me this. if the result is only 1 count ( transpose as is or copy paste as is in single cell and not to insert any space right after.) appreciate your help Thanks |
Code:
Sub ADVANCE_SEARCH()
'Application.Calculation = xlCalculationManual
Dim LastRowColumnA As Long
LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("B3:B" & LastRowColumnA).Formula = "=SUMPRODUCT(LEN(RC[1])-LEN(SUBSTITUTE(RC[1],"","","""")))+1"
LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("C3:C" & LastRowColumnA).Formula = "=MultipleLookupNoRept(RC[-2],All_New_Jobs!C[6]:C[7],2)"
Columns("B:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
''''TEXT TO COLUMN'''''''
Range("C3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("C3"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
''''''TRANSPOSE AND SPACE INSERT'''''''
Range("B3").Select
Do While ActiveCell <> ""
ActiveCell.Select
Dim ins_space As String
ins_space = ActiveCell.Value - 1
If ins_space = 0 Then
ins_space = ins_space + 1
End If
ActiveCell.Offset(1, 0).Range("A1").Select
For s_counter = 1 To ins_space
Selection.EntireRow.Insert
Next s_counter
ActiveCell.Offset(-1, 0).Range("A1").Select
''''add code here
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, -1).Range("A1").Select
Loop
'Application.Calculation = xlCalculationAutomatic
Range("C3:AA20000").ClearContents
Range("A2").Select
End Sub
Last edited by a moderator: