Adding text

[Lowggy]

I have an Excel spreadsheet generated from another program. It is set up so I can print it out on Avery labels but I missed one piece of information I want to add to every block of data. How can I do that in Excel.
thanks in advance.

 

[Lowggy]

.
Click the link, and follow the 'bouncing ball' for download .... (not literally).



It will do what you were asking. Can't promise the label will be able to accept everything you are wanting it to. You may need to adjust the Font size and/or spacing.
Experiment and see.

Thank you very much, I will get back to you in a day or two when I try this out.

 

[Lowggy]

This works fairly well and I much appreciate it. I went in and did an edit on the macro to add the text that I wanted but how do I add a second line of text in the same area ie a longer sentence. Also every time I hit the button it adds another line with the same text.

I have another one if you are up to the challenge. I have a list of 160 golfers, many of them are couples with the same last name. What I want to do is take those two names ie John Smith and Sharon Smith and replace it with Smiths, John and Sharon.

.
Click the link, and follow the 'bouncing ball' for download .... (not literally).



It will do what you were asking. Can't promise the label will be able to accept everything you are wanting it to. You may need to adjust the Font size and/or spacing.
Experiment and see.

 

[Logit]

.
Download workbook with changes : https://www.amazon.com/clouddrive/share/edlionTVx9BxdhC2KYJfYzkxSV8mCWVYiUGd2cAoeM3

New code :

Option Explicit


Sub test1()
    Dim i As Long
    Dim Last As Long
    Dim Rng As Range
    Dim Txt As String
    
    On Error Resume Next
    Txt = Application.ActiveWindow.RangeSelection.Address
    Set Rng = Range("A1:A150") '<<----------------------------Change range of rows here
    If Rng Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Last = Rng.Rows.Count
    
    For i = Last To 1 Step -1
      If InStr(1, Rng.Cells(i, 1).Value, "Team") > 0 Then
        Rows(Rng.Cells(i, 1).Row).Insert shift:=xlDown
      End If
    Next
    
    Application.ScreenUpdating = True
    
    FindBlankAndFill
    
End Sub


Sub FindBlankAndFill()
    Dim cnter As Integer
    Dim lastRow As Long
    Dim i As Integer
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    cnter = 0
    Application.ScreenUpdating = False
    
    For i = 8 To lastRow + 1
        If IsEmpty(Cells(i, 1)) Then
           Cells(i, 1).RowHeight = 40
            Cells(i, 1).Value = " Text 1" & vbCrLf & " Text 1a" & vbCrLf & " Text 1b" '<<------------------ Edit text comment here for Col A
            Cells(i, 4).Value = " Text 2" & vbCrLf & " Text 2a" & vbCrLf & " Text 2b" '<<------------------ Edit text comment here for Col DA
            cnter = cnter + 1
        End If
    Next i
    
    Range("A2").Select
    Selection.EntireRow.Delete
    
    Application.ScreenUpdating = True
End Sub

Hopefully someone else can assist with concatenating the players names.

 

[Lowggy]

Thank you ever so much for all you have done. I just have to learn how to code so I can do those macros myself. Thanks again.

.
Download workbook with changes : https://www.amazon.com/clouddrive/share/edlionTVx9BxdhC2KYJfYzkxSV8mCWVYiUGd2cAoeM3

New code :

Option Explicit


Sub test1()
    Dim i As Long
    Dim Last As Long
    Dim Rng As Range
    Dim Txt As String
    
    On Error Resume Next
    Txt = Application.ActiveWindow.RangeSelection.Address
    Set Rng = Range("A1:A150") '<<----------------------------Change range of rows here
    If Rng Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Last = Rng.Rows.Count
    
    For i = Last To 1 Step -1
      If InStr(1, Rng.Cells(i, 1).Value, "Team") > 0 Then
        Rows(Rng.Cells(i, 1).Row).Insert shift:=xlDown
      End If
    Next
    
    Application.ScreenUpdating = True
    
    FindBlankAndFill
    
End Sub


Sub FindBlankAndFill()
    Dim cnter As Integer
    Dim lastRow As Long
    Dim i As Integer
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    cnter = 0
    Application.ScreenUpdating = False
    
    For i = 8 To lastRow + 1
        If IsEmpty(Cells(i, 1)) Then
           Cells(i, 1).RowHeight = 40
            Cells(i, 1).Value = " Text 1" & vbCrLf & " Text 1a" & vbCrLf & " Text 1b" '<<------------------ Edit text comment here for Col A
            Cells(i, 4).Value = " Text 2" & vbCrLf & " Text 2a" & vbCrLf & " Text 2b" '<<------------------ Edit text comment here for Col DA
            cnter = cnter + 1
        End If
    Next i
    
    Range("A2").Select
    Selection.EntireRow.Delete
    
    Application.ScreenUpdating = True
End Sub

Hopefully someone else can assist with concatenating the players names.

 

[Logit]

.
You are welcome.