Divide cells in selected range by another column value-CodePudding

I'm trying to write a code in Excel VBA that firstly will let user to select a range of values he wants to divide as an input and then select a range that defines the number for division. At this moment the code I wrote works only with a single row, however I would love to amend a query so it will work with multiple rows. Is there any way how to calculate the length of each cell in a range? My code is below:

Sub DivideRange()
    Dim r As Range
    Dim W As Range
    Dim i As Integer
    Dim target_col As Range
   
    myTitle = "divide range by a number"
    Set W = Application.Selection
    Set target_col = Application.Selection
  
   
    
    Application.ScreenUpdating = False
   

        Set W = Application.InputBox("Select a range of cells that you want to divide", myTitle, W.Address, Type:=8)
        Set target_col = Application.InputBox("Select a range of cell that defines number for division", target_col.Address, Type:=8)
       
            
        i = Len(target_col) - Len(Replace(target_col, Chr(10), ""))   1
       
        For Each r In W
        r.Value = r.Value / i
        Next
   
End Sub

Also, please find an example of how table look like. So the idea is that first user selects some cells in A4 and then selects cell in A2 accordingly. And division is done based on how many linebreaks are in A2 in each cell of selected range.

enter image description here

CodePudding user response：

Calculating the number of lines in the cell can use Len, as SJR mentions in his comment. If you get the length of the string in the cell:

Len(B2.Value)

and then substitute all of the line breaks with nothing

Replace(B2.Value, Chr(10), vbNullString)

and take the length of that result

Len(Replace(B2.Value, Chr(10), vbNullString))

and finally substract it from the original length

Len(B2.Value) - Len(Replace(B2.Value, Chr(10), vbNullString))

The result will tell you how many line breaks are in the cell. Of course, the number of lines is one more than the number of line breaks.

Just fiddling around with a full solution, there are many user input checks to make for a full solution. As an example for your learning fun:

Option Explicit

Sub DivideTheRange()
    Dim theRange As Range
    Set theRange = ItsTheCorrectValueRange
    If Not theRange Is Nothing Then
        Dim theDivisor As Long
        theDivisor = SelectedDivisor
        If theDivisor >= 1 Then
            Dim number As Variant
            For Each number In theRange
                number.Offset(0, 5).Value = number.Value / theDivisor
            Next number
        End If
    End If
End Sub

Function ItsTheCorrectValueRange() As Range
    Const numberRange As String = "D3:D5"
    Dim userPrompt As String
    userPrompt = "Select one or more cells from " & numberRange & " that will be divided"
    
    Dim theRange As Variant
    Set theRange = Application.InputBox(Prompt:=userPrompt, _
                                        Title:="Divide Range By A Number", _
                                        Default:=Selection, _
                                        Type:=8) 'type=8 --> cell reference
    
    '--- check for the correct column (and that it's only one column)
    If theRange.Column = ActiveSheet.Range(numberRange).Column Then
        '--- now make sure it's one or more valid rows
        If (theRange.Row >= ActiveSheet.Range(numberRange).Row) And _
           (theRange.Row <= (ActiveSheet.Range(numberRange).Row   _
                             ActiveSheet.Range(numberRange).Rows.Count)) Then
            Set ItsTheCorrectValueRange = theRange
            Exit Function
        End If
    End If
    MsgBox "You must select one or more cells in the range " & numberRange, _
           vbOKOnly   vbCritical, _
           "Error Selecting Input Range"
End Function

Function SelectedDivisor() As Long
    SelectedDivisor = -1
    
    Const numberRange As String = "B3:B5"
    Dim userPrompt As String
    userPrompt = "Select one cell from " & numberRange & " to define the divisor"
    
    Dim divisorRange As Variant
    Set divisorRange = Application.InputBox(Prompt:=userPrompt, _
                                            Title:="User Defined Division", _
                                            Default:=Selection, _
                                            Type:=8) 'type=8 --> cell reference

    '--- check for a single cell...
    If divisorRange.Cells.Count = 1 Then
        '--- ... in the correct column ...
        If divisorRange.Column = ActiveSheet.Range(numberRange).Column Then
            '--- ... and within the correct rows
            If (divisorRange.Row >= ActiveSheet.Range(numberRange).Row) And _
               (divisorRange.Row <= (ActiveSheet.Range(numberRange).Row   _
                                     ActiveSheet.Range(numberRange).Rows.Count)) Then
                '--- count the lines in the cell
                SelectedDivisor = Len(divisorRange.Value) - Len(Replace(divisorRange.Value, Chr(10), vbNullString))
                SelectedDivisor = IIf(SelectedDivisor = 0, 1, SelectedDivisor   1)
                Exit Function
            End If
        End If
    End If
    MsgBox "You must select only one cell in the range " & numberRange, _
           vbOKOnly   vbCritical, _
           "Error Selecting Input Range"
End Function

CodePudding user response：

Sticking as far as possible with your own code, the following works are you requested:

Sub DivideRange()
    Dim r As Range
    Dim W As Range
    Dim i As Integer
    Dim target_col As Range
    Dim LFcount As Integer
   
    myTitle = "divide range by a number"
    Set W = Application.Selection
    Set target_col = Application.Selection

    Application.ScreenUpdating = False
   
     Set W = Application.InputBox("Select a range of cells that you want to divide", myTitle, W.Address, Type:=8)
     Set target_col = Application.InputBox("Select a range of cell that defines number for division", target_col.Address, Type:=8)
    
     If W.Cells.Count <> target_col.Cells.Count Then
        MsgBox "You must select an equal number of cells for both selections. Please try again."
     Else
        i = 0
        For Each r In W.Cells
            i = i   1
            LFcount = Len(target_col.Cells(i)) - Len(Replace(target_col.Cells(i), Chr(10), ""))   1
            r.Value = r.Value / LFcount
        Next
    End If
End Sub