insert space on multiple values

Trev0j

New Member
Joined
May 27, 2018
Messages
28
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:

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Without seeing some data I am finding I can't really follow the code, so I am just wondering is it as simple as this:-
VBA Code:
For s_counter = 1 To ins_space
    If ins_space <> 1 Then
        Selection.EntireRow.Insert
    End If
Next s_counter
 
Upvote 0
Solution
Many thanks Alex!

My code works fine now by adding some codes on my If statement and add a GoTo as well. That's the only way i know but it works.. :)

Like this:

Ins:

ins_space = ActiveCell.Value - 1
If ins_space = 0 Then

ActiveCell.Offset(0, 1).Range("A1").Select
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Offset(1, 0).Range("A1").Select
GoTo Ins

End If
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,218
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top