Posts by Mumps

Mumps · Feb 23rd 2023

Could you please post a revised copy of your file which contains your expected results.

Mumps · Feb 23rd 2023

Quote

7/25/2008: (Chapter 7 is more complicated) 8/23/2022: (Management is decided to leave) 9/2/2021: (Nothing is more curious)

I'm sorry but I don't follow. Do you want to combine the notes for each unique ID in the same cell? Please clarify in detail.

Mumps · Feb 23rd 2023

Try:

Code

Sub ConcatData()
    Application.ScreenUpdating = False
    Dim lRow As Long, v As Variant, i As Long, dic As Object
    Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2:A" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("C2:C" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("B2:B" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:D" & lRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    v = Range("C2", Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v) To UBound(v)
        If Not dic.exists(v(i, 1)) Then
            dic.Add v(i, 1), v(i, 1) & ": (" & v(i, 2)
        Else
            dic.Item(v(i, 1)) = dic.Item(v(i, 1)) & " " & v(i, 2)
        End If
    Next i
    With ActiveSheet
        .Range("B:B,D:D").Delete Shift:=xlToLeft
        .Range("A1", .Range("B" & .Rows.Count).End(xlUp)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
        .Columns(2).Delete
        .Range("B2").Resize(dic.Count) = Application.Transpose(dic.items)
        .Range("B2").Resize(dic.Count).Value = Evaluate(.Range("B2").Resize(dic.Count).Address & "&""" & ")" & """")
        .Columns.AutoFit
    End With
    Application.ScreenUpdating = True
End Sub

Display More

Mumps · Feb 19th 2023

Glad to have been able to help.

Mumps · Feb 18th 2023

Try:

Code

Sub ConcatData()
    Application.ScreenUpdating = False
    Dim lRow As Long, v As Variant, i As Long, dic As Object
    Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2:A" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("C2:C" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("B2:B" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:D" & lRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    v = Range("C2", Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v) To UBound(v)
        If Not dic.exists(v(i, 1)) Then
            dic.Add v(i, 1), v(i, 2)
        Else
            dic.Item(v(i, 1)) = dic.Item(v(i, 1)) & " " & v(i, 2)
        End If
    Next i
    With ActiveSheet
        .Range("B:B,D:D").Delete Shift:=xlToLeft
        .Range("A1", .Range("B" & .Rows.Count).End(xlUp)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
        .Range("C2").Resize(dic.Count) = Application.Transpose(dic.items)
        .Columns.AutoFit
    End With
    Application.ScreenUpdating = True
End Sub

Display More

Mumps · Dec 31st 2022

Your "VBA CODE" refers to sheets that don't exist in your workbook. Please explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data. It would also help if you include a sheet that shows what your email should look like.

Mumps · Oct 19th 2022

Try:

Code

Sub DeleteRows()
    If MsgBox("Are you sure you want to clear the worksheet?", vbYesNo) = vbYes Then
        ActiveSheet.ListObjects("tabela1").DataBodyRange.Delete
    End If
End Sub

Mumps · Oct 19th 2022

If you want to delete only row 8 from column B to column V try:

Code

Sub DeleteRow()
    Rows(8).Delete
End Sub

If you want to delete all the rows in your table, try:

Code

Sub DeleteRows()
    ActiveSheet.ListObjects("tabela1").DataBodyRange.Delete
End Sub

Mumps · Oct 18th 2022

Could you attach a copy of your file? It would be easier to see how your data is organized and to test possible solutions. Include a detailed explanation

of what you want to do using a few examples from your data and referring to specific cells, rows, columns and sheets. De-sensitize the data if necessary.

Mumps · Oct 8th 2022

Could you attach a copy of your file including your current macros? It would be easier to see how your data is organized and to test possible solutions. Include a detailed explanation of what you want to do using a few examples from your data and referring to specific cells, rows, columns and sheets. De-sensitize the data if necessary.

Mumps · Oct 7th 2022

Could you attach a copy of your file? It would be easier to see how your data is organized and to test possible solutions. Include a detailed explanation

of what you want to do using a few examples from your data and referring to specific cells, rows, columns and sheets. De-sensitize the data if necessary.

Mumps · Oct 5th 2022

My apologies. I just noticed that you marked the thread as "Resolved".

Mumps · Oct 5th 2022

Quote from ely80

DG;DH;DI;DJ

These columns in your file do not contain any data. It would be helpful if you could post a revised file with some data in those columns.

Quote from ely80

new excel template that will have the defined headers named RPA PnL Offer Template

Does the macro have to create the new template? By "template" do you mean a new worksheet? Also, I don't understand where the headers (in red) come into play. Please clarify in detail. Does this new "template" have the headers below in row 1?

Quote from ely80

Customer Account Number
Group Name
MSISDN
New Tariff Plan
Fixed monthly payment for Plan (VAT Inc.)

It would also help if you could include a manually created sheet in your revised workbook that shows the desired result based on the data in DG;DH;DI;DJ.

Mumps · Oct 5th 2022

Could you attach a copy of your file including any macros you are currently using? It would be easier to see how your data is organized and to test possible solutions. Include a detailed explanation of which fields are mandatory, referring to specific cells, rows, columns and sheets. De-sensitize the data if necessary.

Mumps · Oct 3rd 2022

You are very welcome.

Mumps · Sep 30th 2022

Try:

Code

Sub InsertDate()
    Application.ScreenUpdating = False
    Dim sDate As String
    If MsgBox("Do you wish to insert a date?", vbYesNo) = vbNo Then Exit Sub
    sDate = InputBox("Please enter a date.", "Date", Date)
    If Not IsDate(sDate) Then
        MsgBox ("Invalid date.  Please try again.")
        Exit Sub
    Else
        Range("AW" & ActiveCell.Row) = Date
    End If
    Application.ScreenUpdating = False
End Sub

Display More

Mumps · Sep 7th 2022

You are very welcome.

Mumps · Sep 6th 2022

Try:

Code

Sub CompareData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, dic As Object, i As Long
    Set desWS = Sheets("Sheet1")
    Set srcWS = Sheets("Sheet2")
    v1 = desWS.Range("D1", desWS.Range("D" & Rows.Count).End(xlUp)).Value
    v2 = srcWS.Range("D1", srcWS.Range("D" & Rows.Count).End(xlUp)).Resize(, 3).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        dic.Add v1(i, 1), i
    Next i
    For i = LBound(v2) To UBound(v2)
        If dic.exists(v2(i, 1)) Then
            desWS.Range("E" & dic(v2(i, 1))).Resize(, 2).Value = Array(v2(i, 2), v2(i, 3))
        Else
            srcWS.Range("D" & i).Resize(, 10).Copy desWS.Cells(desWS.Rows.Count, "D").End(xlUp).Offset(1)
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Display More

Change the sheet names to suit your needs.

Mumps · Sep 6th 2022

Try:

Code

Sub TransposeData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, LastRow As Long, r As Long, c As Long, col As Long: col = 2
    Set srcWS = Sheets("Input")
    Set desWS = Sheets("Output")
    desWS.Range("A1") = "No"
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For r = 2 To LastRow
        cnt = WorksheetFunction.CountA(srcWS.Rows(r)) - 1
        With desWS
            For c = 1 To cnt
                .Cells(1, col).Value = srcWS.Cells(r, 1)
                .Cells(2, col).Value = srcWS.Cells(r, c + 1)
                col = col + 2
            Next c
        End With
    Next r
    Application.ScreenUpdating = True
End Sub

Display More

Mumps · Sep 5th 2022

Try:

Code

Sub TransposeData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, LastRow As Long, r As Long, c As Long, col As Long: col = 2
    Set srcWS = Sheets("Input")
    Set desWS = Sheets("Output")
    desWS.Range("A1") = "No"
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For r = 2 To LastRow
        cnt = WorksheetFunction.CountA(Rows(r)) - 1
        With desWS
            For c = 1 To cnt
                .Cells(1, col).Value = Cells(r, 1)
                .Cells(2, col).Value = Cells(r, c + 1)
                col = col + 2
            Next c
        End With
    Next r
    Application.ScreenUpdating = True
End Sub

Display More

Posts by Mumps

Comparing 2 columns and concatenating the Data of adjacent column

Comparing 2 columns and concatenating the Data of adjacent column

Comparing 2 columns and concatenating the Data of adjacent column

Comparing 2 columns and concatenating the Data of adjacent column

Comparing 2 columns and concatenating the Data of adjacent column

VBA for employee payslips pdf and email

Failed to delete lines from the worksheet

Failed to delete lines from the worksheet

Failed to delete lines from the worksheet

Update my existing macro to be able to update and delete

automatically paste a phrase in an email body and send the email

VBA macro of copy data from one excel to another template

VBA macro of copy data from one excel to another template

Mandatory field

Input Date in specific column of selected cells

Input Date in specific column of selected cells

Repeated Column Data Transpose From Column to Rows.

If WS 2 ID exists in WS 1, update WS 1 column value, else create new row with WS 2 data

Repeated Column Data Transpose From Column to Rows.

Repeated Column Data Transpose From Column to Rows.