Naimul Hasan Arif

Thanks all of you guys for your comments.
I think so many people are facing the same problem of applying the code in a range of cells. In our article, the VBA code that we have shown only works for a fixed cell. So, I am going to give you guys a slightly modified VBA code that will work for a range of cells( i.e. entire D column).

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Oldvalue As String
Dim Newvalue As String
Dim mn As Range, pq As Range
On Error GoTo Exitsub
Set mn = Range(“D:D”)
For Each pq In mn
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = “” Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = “” Then
Target.Value = Newvalue
Else
Target.Value = Oldvalue & “, ” & Newvalue
End If
End If
Next pq
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

Hello AB,
Thanks for your response. We can certainly insert multiple photos in one row or column in a simple way. Just follow the following steps:

1. Select your data in ascending order as the images will be inserted in the ascending order. For this, go to:
   Select data > Home tab > Sort & Filter feature > Sort A to Z.
   
2. Now, go to Page Layout mode from the View tab and set the cell height and width.
   
3. Select the first cell where you want to insert the first image.
4. To insert multiple images, go to the Insert tab > Picutres feature > Place over Cells option > This Device…
   
   
5. Right-click on the mouse and select Size and Properties…
   
6. Uncheck the Lock aspect ratio option.
7. Adjust the image size according to the cell size.
   
8. Set the last image manually.
9. Now, select the rest images and align left from Picture Format.
   
10. Now. distribute the images in a column with Distribute Vertically.
    

Thus, you will have all the images in a single column.

Similarly, you cam insert multiple photos in a single row.

Let me know if this is helpful for you or not.

Regards,
Naimul Hasan Arif

Hello SAPTARSHI,
I have personally sent a mail with a mail body of more than 255 characters via the “Using VBA Macro to Automatically Send Email Using Outlook to Selected Recipients” method. The receiver got the mail with the full mail body. I have used Microsoft 365 and found no character restriction in this process.
Regards,
Naimul Hasan Arif

Dear ROBERT STREMPKE,
Thanks for your comment. If you go through this article, you might have known that we can extract the defined information with the barcode through scanning. We can also have the sum of all goods in Excel. If you have multiple handheld readers, you can create a separate worksheet for each barcode scanner and summarize them in a new worksheet. In the summarized sheet, you can define the inventory stock balance and subtract the total sold products summing them from different sheets. I hope you have got what you are searching for.
Regards,
MD NAIMUL HASAN

Dear G BHARATHI PRABHA,
Thanks for your response. I have used exactly the same code for my workbooks and it works perfectly. A little reminder for you that keep both the files in the same folder and keep both the files open. In order to avoid the error Subscript out of range, Try to run the code by keeping both the files open. I hope this will solve your problem.
Regards,
Naimul Hasan Arif

Dear TURAN,
Thanks for your valuable comment. That was an honest mistake from me. I have updated the error. I have also modified the code as I have found a simpler way to perform the same task.

Best Regards,
Naimul Hasan Arif

Hello JENELLE CASTRO,

Thanks for your question. If you have the same password in all the files placed in a certain folder, you can apply the following VBA code.

Sub UnProtect_Multiple_Files()
Dim FName As String
Dim Path As String
Dim FSearch As String

Path = "C:\Users\Dell\Desktop\Arif\Update\"
FSearch = "*.xls"
FName = Dir(Path & FSearch)
Do While FName <> ""
Workbooks.Open FileName:=Path & FName
Workbooks(FName).UnProtect "1234"
Workbooks(FName).Save
Workbooks(FName).Close
FName = Dir()
Loop
End Sub

Make necessary adjustments in the code in the Path and Password sections. I hope this is the solution which you are looking for.

Regards,
Naimul Hasan Arif

Dear MUHAMMAD,
In order to apply the number to words conversion in all worksheets of a particular workbook., you can create a function and place it in a module. As you have created a function in a module, it will be available in all worksheets of that particular workbook.

Like I have created a module and a function named number_converting_into_words with the following VBA code.

Function number_converting_into_words(ByVal MyNumber)
Dim x_string As String
Dim whole_num As Integer
Dim x_string_pnt
Dim x_string_Num
Dim x_pnt As String
Dim x_numb As String
Dim x_P() As Variant
Dim x_DP
Dim x_cnt As Integer
Dim x_output, x_T As String
Dim x_my_len As Integer
On Error Resume Next
x_P = Array("", "Thousand ", "Million ", "Billion ", "Trillion ", " ", " ", " ", " ")
x_numb = Trim(Str(MyNumber))
x_DP = InStr(x_numb, ".")
x_pnt = ""
x_string_Num = ""
If x_DP > 0 Then
x_pnt = " point "
x_string = Mid(x_numb, x_DP + 1)
x_string_pnt = Left(x_string, Len(x_numb) - x_DP)
For whole_num = 1 To Len(x_string_pnt)
x_string = Mid(x_string_pnt, whole_num, 1)
x_pnt = x_pnt & get_digit(x_string) & " "
Next whole_num
x_numb = Trim(Left(x_numb, x_DP - 1))
End If
x_cnt = 0
x_output = ""
x_T = ""
x_my_len = 0
x_my_len = Int(Len(Str(x_numb)) / 3)
If (Len(Str(x_numb)) Mod 3) = 0 Then x_my_len = x_my_len - 1
Do While x_numb <> ""
If x_my_len = x_cnt Then
x_T = get_hundred_digit(Right(x_numb, 3), False)
Else
If x_cnt = 0 Then
x_T = get_hundred_digit(Right(x_numb, 3), True)
Else
x_T = get_hundred_digit(Right(x_numb, 3), False)
End If
End If
If x_T <> "" Then
x_output = x_T & x_P(x_cnt) & x_output
End If
If Len(x_numb) > 3 Then
x_numb = Left(x_numb, Len(x_numb) - 3)
Else
x_numb = ""
End If
x_cnt = x_cnt + 1
Loop
x_output = x_output & x_pnt
number_converting_into_words = x_output
End Function

Now, you can call the function in all worksheets of that particular workbook in the following way and have your number converted into words.

I hope you have found your desired answer.

Your regards,
Naimul Hasan Arif

Dear LUIS FERNANDO,
Thanks for the appreciation. Also big thanks to you for sharing your insights on the query of CHRISTOFER.

In response to your purpose, I have considered a case where I will have a drop-down with the names of the writers. Based on the writer selection, his books will appear in another drop-down just below the cell of the writer’s name.

I have assigned the following code in a button where I will have writers’ names without repetition under Uniquelist column.  I have created a drop-down in cell C14 with those values. Similarly, I have sorted the matched books under Sorted Books column with the writer’s name in C14.

Sub Uniquelist()

Set Rng = Range("B4:B11")
Set Rng2 = Range("E4")

Rng2.Cells(1, 1).Value = Rng.Cells(1, 1)
Count = 1

For i = 2 To Rng.Rows.Count
    Found = False
    For j = 1 To Rng2.Rows.Count
        If Rng.Cells(i, 1).Value = Rng2.Cells(j, 1) Then
            Found = True
            Exit For
        End If
    Next j
    
    If Found = False Then
        Set Rng2 = Range(Cells(4, 5), Cells(4 + Count, 5))
        Cells(4 + Count, 5) = Rng.Cells(i, 1)
        Count = Count + 1
    End If
        
Next i

With Range("C14").Validation
                    .Delete
                    .Add Type:=xlValidateList, _
                    AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, Formula1:="=$E$4:$E$6"
End With

Range("$E$13:$E$15").ClearContents

n = 0
For i = 1 To Rng.Rows.Count
    If Rng.Cells(i, 1) = Cells(14, 3).Value Then
        Cells(13 + n, 5) = Rng.Cells(i, 2)
        n = n + 1
    End If
Next i


With Range("C15").Validation
                    .Delete
                    .Add Type:=xlValidateList, _
                    AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, Formula1:="=$E$13:$E$15"
End With

End Sub

Now, select a writer name from drop-down and click on Sort button. You will have the related books’ name in the following drop-down and choose a book according to your preference.

Thanks a lot BABALOLA for the appreciation. It means a lot.
In response to your first question, let me break down the whole formula with IFERROR, INDEX, MATCH & SUM and explain it to you.

The first part of the formula here is IFERROR(INDEX(Jan!AH$9:AH$13,MATCH($B10,Jan!$B$9:$B$13,0)),0)
First of all the MATCH function looks through the value in range B9:B13 of Jan sheet whether it matches the value in cell B10. If it gets matched, it will return the related value according to the index from the AH9:AH13 range. The IFERROR Function is used to return a value(i.e. 0) if it can not find any proper value to return.
Similarly, I have gone through all 12 months’ sheets and added them with the SUM function.

In response to your second question, the & sign is used to concatenate cell AH$8 with the letter H. As it is considered a half match, 0.5 is multiplied. We have considered two half-matches to have the full match count.

Dear SRECKO SELENDIC,
Thanks for your appreciation. It means a lot. In order to set sheet names based on cell reference, we can use a For loop along with Worksheets.name property. Here, I have written a code to split sheet and rename sheet split sheet keeping the main sheet name unchanged. Follow the following code to do so.

Sub SplitSheet()
Dim Rng As Range
Dim xRow As Range
Dim SplitRow As Integer
Dim xSheet As Worksheet
On Error Resume Next
xTitleId = "ExcelSplit"
Set Rng = Application.Selection
Set Rng = Application.InputBox("Range", xTitleId, Rng.Address, Type:=8)
SplitRow = Application.InputBox("Row Number Split", xTitleId, 5, Type:=1)
Set xSheet = Rng.Parent
Set xRow = Rng.Rows(1)
Application.ScreenUpdating = False
For i = 1 To Rng.Rows.Count Step SplitRow
resizeCount = SplitRow
If (Rng.Rows.Count - xRow.Row + 1) < SplitRow Then resizeCount = Rng.Rows.Count - xRow.Row + 1
xRow.Resize(resizeCount).Copy
Application.Worksheets.Add after:=Application.Worksheets(Application.Worksheets.Count)
Application.ActiveSheet.Range("A1").PasteSpecial

For j = 2 To Worksheets.Count
Worksheets(j).Name = "DE" & j - 1
Next j

Set xRow = xRow.Offset(SplitRow)
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub 

The output will be like the following image.

Hello Mark,
Glad to hear from you. There might be one of several reasons for not having the desired output. If the file is corrupted, protected, or scanned, there will be problem in extracting data. It will be helpful for me to specify the problem if you could send me the file and the code at [email protected].

Thanks for your appreciation. It means a lot.
To solve your problem, I will suggest you to change your separator from Control Panel. I hope it’ll solve the separator problem.

Hello BHAVNESH,
Have a look at Article 1 and Article 2. I hope it will help you to meet your desire.

Thanks for your response.
Normally additional information associated with Barcode is connected through a centralized dataset. When a UPC (Universal Product Code) code is scanned, the scanner sends the code to a server, which looks up the corresponding information in the database and sends it back to the scanner. In other cases like QR codes, the additional information might not be stored in a centralized dataset. QR codes can encode a URL that will take you to the related information regarding the product through scanning.

Hello VULSTA KUZENA,
Thanks for your comment. In my case, the code runs just perfect. I have not got any error message. There might have some extra characters in that place. You can try it or send me the file to [email protected] to let me have a try.

Hello JACKIE,
Thanks for your comment. If we use these formulae, it will generate the date from that device (PC/Laptop/Mobile). So, check the date of your device first.
I think it will solve your problem.

Hello Darko,
Thanks for your valuable comment. This problem should not occur if the values are generated within Excel. However, This problem might happen if you copy and paste data from the web pages. In that case, there might have some non-printable characters which are preventing you from sorting data.
To check if there are any non-printable characters, use the LEN function to have the length of those cells.
If they are not giving proper output, apply the following formula to remove the non-printable characters.
=CLEAN(A1)*1
After that, I hope the Sort function will work perfectly.

Definitely possible. You just need to follow the following procedures to do so.
After selecting the entire dataset, go to the Insert tab. Followingly, click on Filled Map from the Maps option and you will have your desired output.

Thanks for your valuable comment.
A few factors might play a vital role in your problem.
1. As the file contains VBA code, the file must be saved in “.xlsm” format.
2. Don’t forget to change the ranges in your code. I have applied the code in D column. So, it’ll only be applicable in the D column.

Thank you AHAMED for your query.
For the explanation on how to mail merge Excel to Excel, you can check the following link:
https://www.exceldemy.com/mail-merge-from-excel-to-excel/
I hope it will fulfill your need.

Thanks for your comment. Look, I have used the following formula to Find If A Range of Cells Contains Specific Text in Excel.

=COUNTIF(B5:B19,”*”&D5&”*”)>0

Here, I have just mentioned the range B5:B19. So, in this way, it is not mandatory to know the exact row where Winter is Coming is written.

Thanks for your query.

It’s kind of a complicated task to filter specific data from certain cells of different worksheets with certain condition. I have tried a possible simple solution to pull data from different sheets into one sheet using FILTER function.I have used the following dataset for filtering the rows having Geller as Last Name and replace the Geller word with blank.

I have used the following formula to fulfill the purpose.

=FILTER(IF(Dataset!B4:J17=”Geller”,””,Dataset!B4:J17),Dataset!C4:C17=”Geller”)

For further information related to Excel, you can send message via email. email id: [email protected] 

Thanks for sharing your valuable thoughts.

There is social media connection link in the introduction section about author. You can send message there.

Use of “for loop” function is a very simple approach for this purpose. You can use the following code to merged the defined cells to 100 tabs. Based on your sheets, you just need to change the value of “i” in the code.

Option Explicit
Public Sub FitTheMergedCells()
Call MergedCellsAutoFit(Range(“B5:C6”))
Call MergedCellsAutoFit(Range(“B7:C8”))
Call MergedCellsAutoFit(Range(“B9:C11”))
Call MergedCellsAutoFit(Range(“B12:C12”))
End Sub
Public Sub MergedCellsAutoFit(gg As Range)
Dim aa As Integer
Dim bb As Integer
Dim cc As Single
Dim dd As Single
Dim ee As Single
Dim ff As Single
Dim i As Integer
For i = 1 To 100
With Sheets(“Sheet” & i)
cc = 0
For bb = 1 To gg.Columns.Count
cc = cc + .Cells(1, gg.Column + bb – 1).ColumnWidth
Next bb
cc = .Cells(1, gg.Column).ColumnWidth + .Cells(1, gg.Column + 1).ColumnWidth
gg.MergeCells = False
ee = Len(.Cells(gg.Row, gg.Column).Value)
dd = .Range(“ZZ1”).ColumnWidth
.Range(“ZZ1”) = Left(.Cells(gg.Row, gg.Column).Value, ee)
.Range(“ZZ1”).WrapText = True
.Columns(“ZZ”).ColumnWidth = cc
.Rows(“1”).EntireRow.AutoFit
ff = .Rows(“1”).RowHeight / gg.Rows.Count
.Rows(CStr(gg.Row) & “:” & CStr(gg.Row + gg.Rows.Count – 1)).RowHeight = ff
gg.MergeCells = True
gg.WrapText = True
.Range(“ZZ1”).ClearContents
.Range(“ZZ1”).ColumnWidth = dd
End With
Next i
End Sub

Yeah. There are ways to sort columns in descending order.
You can apply the following VBA in the dataset used in the first method to sort the data in descending order.

Sub SortSingleColumnWithoutHeader()
Range(“B5”, Range(“B5”).End(xlDown)).Sort Key1:=Range(“B5”), Order1:=xlDescending, Header:=xlNo
End Sub

I have tried the following VBA code for all the cells in D Column. I hope this is the thing you are looking for.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Oldvalue As String
Dim Newvalue As String
Dim mn As Range, pq As Range
On Error GoTo Exitsub
Set mn = Range(“D:D”)
For Each pq In mn
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = “” Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = “” Then
Target.Value = Newvalue
Else
Target.Value = Oldvalue & “, ” & Newvalue
End If
End If
Next pq
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

Thanks for your appreciation. It means a lot.

I have the use the following formula for this case.

=TEXTJOIN(“, “,TRUE,IF(F5=$C$5:$C$15,$B$5:$B$15,””))

Thanks for your insight and for trying something on your own.

You can use the Clear property of the cell. You need to apply Range(“__your cell__”).Clear to make the selection cleared.

If you want to traverse through a column, you can wrap your code with loop which will continue throughout the column.

Hi,

For columns A:
From the Data tab, select Data Tools and pick Data Validation from there. This will open the Data validation feature. From there, mention the text length of minimum “1” to maximum “8”.

For column B, follow the same procedure. Just in the maximum section, input “10”.

You can try using SpecialCells(xlCellTypeVisible) property while setting the detailsLastRow object. SpecialCells(xlCellTypeVisible) will trigger Excel to consider visible cells only. I hope this edited VBA will help you to get your desired output.

Sorry DIEGO for my late response.
There needs to make some changes in the formula in case of finding the second last non blank cell.
I have used the following formula using LOOKUP function in cells D5 to D15 that is the chemistry marks in the dataset to find the second last non-blank cell.
=LOOKUP(2,1/((D5:D15<>D15)*(D5:D15<>“”)),D5:D15)

My dataset is given below:

Second Last Non Blank Value

Name Physics Chemistry
Green 164 110 (D5)
Jack 185 165
Joey 178 132
Mark 183 137
Austin 165 112
Marvin 173 119
Mason 186 170
Mount 170
Martin 177 160
Freeman 164
Federer 163 111 (D15)

Second Last Non Blank Value 160

For me it worked perfectly. I hope it will work the same way for you too.