Macro help

[Aerowil2016]

Good day.

I am now programming in vda in excel and I need to get a code for specific task.

The idea is in a set of data thta some times might have 2 rows to 1000 i need to find the most common value based on a column that I need to create in a specific sheet in this way columns A, B, C, D has values in column A will have two possible values (Sender or Receiver) in column E macro needs to paste values from rows in columns C and D depending value in Column A (for Sender copy value in column C and for receiver copy value from column D). Once in column E all values are in raws need to find most common value and if the value in raw E1 is the most common in cell F1 need to add text "main" if the value is not the most common add value "other" them same for all raws in column F

 

[PeteWright]

@Aerowil2016 Could you please tell me, what "the most common value" would be?
From what you wrote it is not clear to me.
Is it a number (N) that gets closer to a specific value (V) such that the difference is as close to 0 as possible?
Like: |N|-|V| ~= 0
Maybe you could provide a sample sheet with some data so that it gets clearer what you need.

 

[Aerowil2016]

@Aerowil2016 Could you please tell me, what "the most common value" would be?
From what you wrote it is not clear to me.
Is it a number (N) that gets closer to a specific value (V) such that the difference is as close to 0 as possible?
Like: |N|-|V| ~= 0
Maybe you could provide a sample sheet with some data so that it gets clearer what you need.

@PeteWright, you can find sample sheet. Columns E : =IF(A2="Sender",C2,D2) and F: =IF(E2=MODE(E:E),"Main","Other") are formulary of what I want macro to do, take into account that it needs to work with 1, 2 or X numbers of rows. Hope this clarify you question

 

[Aerowil2016]

 

[PeteWright]

@Aerowil2016 here's a simple macro you could use:

Sub Macro1()
   Dim Cell As Range
   Dim Data As Range
   Dim FirstRow As Long
   Dim LastRow As Long
   Dim i As Long 'Counter Variable
   Dim FormulaE As String '= IF(A2="Sender",C2,D2)
   Dim FormulaF As String '= IF(E2=MODE(E:E),"Main","Other")
   FormulaE = "= IF(A*=""Sender"",C*,D*)"
   FormulaF = "= IF(E*=MODE(E:E),""Main"",""Other"")"
   
   FirstRow = 2 'the first row with data to evaluate
   LastRow = ActiveSheet.cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
   Set Data = Range("A2:A" & LastRow)
   
   For i = FirstRow To LastRow
      'if there are empty cells in column A, C or D, write an error message into reslut cells
      If cells(i, 1) = "" Or cells(i, 3) = "" Or cells(i, 4) = "" Then
         cells(i, 5).Value = "ERROR: EMPTY CELLS!" 'text to be displayed in column E
         cells(i, 6).Value = "ERROR: EMPTY CELLS!" 'text to be displayed in column F
      Else
         cells(i, 5).Formula = Replace(FormulaE, "*", i)
         cells(i, 6).Formula = Replace(FormulaF, "*", i)
         'alternative code to insert formulas:
         'cells(i, 5).Formula = "= IF(A" & i & " =""Sender"",C" & i & ",D" & i & ")"
         'cells(i, 6).Formula = "= IF(E" & i & "=MODE(E:E),""Main"",""Other"")"
      End If
   Next i
End Sub

Explanations:
I used your formulas and inserted them via VBA into the sheet instead of using functions.
To handle the case if one of the cells used for calculation is empty I let VBA insert the text "ERROR: EMPTY CELLS!" in columns E and F.
Assuming that column A has some values I took the range starting in A2 and going to the last used cell in column A.

Please let me know if you're happy with that or have any further questions.

 

[Aerowil2016]

@Aerowil2016 here's a simple macro you could use:

Sub Macro1()
   Dim Cell As Range
   Dim Data As Range
   Dim FirstRow As Long
   Dim LastRow As Long
   Dim i As Long 'Counter Variable
   Dim FormulaE As String '= IF(A2="Sender",C2,D2)
   Dim FormulaF As String '= IF(E2=MODE(E:E),"Main","Other")
   FormulaE = "= IF(A*=""Sender"",C*,D*)"
   FormulaF = "= IF(E*=MODE(E:E),""Main"",""Other"")"
  
   FirstRow = 2 'the first row with data to evaluate
   LastRow = ActiveSheet.cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
   Set Data = Range("A2:A" & LastRow)
  
   For i = FirstRow To LastRow
      'if there are empty cells in column A, C or D, write an error message into reslut cells
      If cells(i, 1) = "" Or cells(i, 3) = "" Or cells(i, 4) = "" Then
         cells(i, 5).Value = "ERROR: EMPTY CELLS!" 'text to be displayed in column E
         cells(i, 6).Value = "ERROR: EMPTY CELLS!" 'text to be displayed in column F
      Else
         cells(i, 5).Formula = Replace(FormulaE, "*", i)
         cells(i, 6).Formula = Replace(FormulaF, "*", i)
         'alternative code to insert formulas:
         'cells(i, 5).Formula = "= IF(A" & i & " =""Sender"",C" & i & ",D" & i & ")"
         'cells(i, 6).Formula = "= IF(E" & i & "=MODE(E:E),""Main"",""Other"")"
      End If
   Next i
End Sub

Explanations:
I used your formulas and inserted them via VBA into the sheet instead of using functions.
To handle the case if one of the cells used for calculation is empty I let VBA insert the text "ERROR: EMPTY CELLS!" in columns E and F.
Assuming that column A has some values I took the range starting in A2 and going to the last used cell in column A.

Please let me know if you're happy with that or have any further questions.

Thank you, i will try it tomorrow and let you know, only one question what I need to change in the code in case i have multiple worksheets and the datę to apply the vda is for intance in sheet 3?

 

[PeteWright]

@Aerowil2016 The simplest way (without VBA) is to select your desired sheet, click into any cell on that sheet and then run the macro.
The VBA code will be performed on the currently active sheet.

 

[Aerowil2016]

The one without the vda is good but the thing is that I need the vda working in sheet 3 even if I am working in a different sheet. Let's say that I am in sheet 2 and without changing the sheet I need vda in sheet 3

 

[PeteWright]

@Aerowil2016 try this code:

Sub Macro1()
   Dim ws As Variant
   Dim msg As String
   Dim sht As Worksheet
   Dim Cell As Range
   Dim Data As Range
   Dim FirstRow As Long
   Dim LastRow As Long
   Dim i As Long 'Counter Variable
   Dim FormulaE As String '= IF(A2="Sender",C2,D2)
   Dim FormulaF As String '= IF(E2=MODE(E:E),"Main","Other")

WorksheetSelect:
   On Error Resume Next
   ws = Application.InputBox("Please enter Worksheet name", "Sheet Selection", "Sheet1", , , , , 2)
   If ws = False Then Exit Sub
   On Error Resume Next
   If IsObject(ThisWorkbook.Worksheets(ws)) = False Then
      msg = MsgBox("""" & ws & """ not found. Continue?", vbYesNo, "Worksheet not found")
      If msg = vbNo Then
         GoTo ProcedureEnd
      Else
         GoTo WorksheetSelect
      End If
   End If
   
   Set sht = ThisWorkbook.Worksheets(ws)
   FormulaE = "= IF(A*=""Sender"",C*,D*)"
   FormulaF = "= IF(E*=MODE(E:E),""Main"",""Other"")"
   FirstRow = 2 'the first row with data to evaluate
   LastRow = sht.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
   
   If LastRow = 1 Then
      MsgBox "No Data found in Column A of " & sht.name
      GoTo WorksheetSelect
   End If
   
   Set Data = sht.Range("A2:A" & LastRow)

   For i = FirstRow To LastRow
      'if there are empty cells in column A, C or D, write an error message into reslut cells
      If sht.Cells(i, 1) = "" Or sht.Cells(i, 3) = "" Or sht.Cells(i, 4) = "" Then
         sht.Cells(i, 5).Value = "ERROR: EMPTY CELLS!" 'text to be displayed in column E
         sht.Cells(i, 6).Value = "ERROR: EMPTY CELLS!" 'text to be displayed in column F
      Else
         sht.Cells(i, 5).Formula = Replace(FormulaE, "*", i)
         sht.Cells(i, 6).Formula = Replace(FormulaF, "*", i)
         'alternative code to insert formulas:
         'sht.cells(i, 5).Formula = "= IF(A" & i & " =""Sender"",C" & i & ",D" & i & ")"
         'sht.cells(i, 6).Formula = "= IF(E" & i & "=MODE(E:E),""Main"",""Other"")"
      End If
   Next i
ProcedureEnd:
End Sub

However, this code only works for data in columns A2:A* to D2:D* (as you described)

Please let me know if this is what you need, otherwise tell me what other requirements you have for the macro.

 

[Peter_SSs]

@Aerowil2016
If one of the thread posts answers your question then you can mark that post as the solution to help future readers. Otherwise, please do not mark a post that doesn't contain a solution. I have removed the solution mark from post 8 as it does not contain a solution.