Software Applications Programming Errors and solutions.

Macro That Automatica​lly Updates Data Itself In Excel If you need to have a database that automatically updates itself.  In fact, if you have a folder with different excel files, say folder Y (all the same form/template), and the first X cells of these files need to be extracted to another excel workbook (file Z). Every file represents 1 row in workbook  Z. But this should be done automatically. So if I copy a new excel file in folder Y, the first X of this new excel file should automatically (can be with a ‘button demand’)  be copied into workbook Y. Option Explicit Const cstFolder = "C:\Users\ATC0155\Documents\Toolbox\Excel\1208 20 selfupdate" Const cstCols = 5 Sub DoUpdate() Dim wks As Worksheet Dim strFile As String Dim appExcel As Excel.Application Dim lngRow As Long ' Prepare the sheet to receive the data Set wks = Sheet1 wks.Cells.ClearContents ' Run through each file in the folder strFile = Dir(cstFolder ...

Insert a Chart Built in a Workbook Into Another Workbook Insert into allocated Cells region in a workbook resulted charts built in a different workbook, Can this be done? How would you integrate that chart into some kind of place holder in the workbook that is expecting to get that chart Sub CopyChart() ' Copy Chart 'Chart 1' from ThisWorkbook Worksheet 'Sheet1' ' to Workbook 'BookB.xlsm' Worksheet 'Sheet1', ' at specified position. '-- Dim wbkSource As Workbook ' Source Workbook Dim wksSource As Worksheet ' Source Worksheet ' Top-Left cell where Chart is going to be pasted Dim cSourceTopLeft As Range Dim sTargetTopLeft As String ' Chart Top-Left cell address '-- Dim wbkTarget As Workbook ' Target Workbook Dim wksTarget As Worksheet ' Target Worksheet ' Top-Left cell where Chart is going to be pasted Dim cTargetTopLeft As Range Dim sFil...

Match and Sort Text in Two Columns in MS EXCEL Sub LarsSort() Dim lngColA As Long Dim lngColC As Long Dim rngColC As Range Dim varColC As Variant Dim i As Long ' How many rows in column A? lngColA = Range("A" & Rows.Count).End(xlUp).Row ' For each item in column A, see if there is a match in column C For i = 1 To lngColA On Error Resume Next Set rngColC = Columns(3).Find(What:=Range("A" & i).Value, After:=Range("C" & i), LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) On Error GoTo 0 If rngColC Is Nothing Then ' No match. Move the contents of column C to the end (if there is a value) If Range("C" & i).Value <> "" Then Range("C" & (WorksheetFunction.Max(Range("C" & Rows.Count).End(xlUp).Ro...

Code to find  to count blank cells in excel dim c as long on error resume next c = range("d42:d51").specialcells(xlcelltypeblanks).count on error goto 0 if c>0 then msgbox "your message here",vbcritical end if

Code to concatenate multiple cells in a range using excel macro Sub Combine_Multiple_Cells() On Error Resume Next Application.DisplayAlerts = False Dim Myrange As Range Dim mydelim As String Dim Combine As String Dim eachcell As Range Dim getvalue As Range Set Myrange = Application.InputBox(Prompt:="Please select a range with your Mouse to be Concatenated.", Title:="dseri", Type:=8) On Error GoTo 0 If Myrange Is Nothing Then Exit Sub Else mydelim = Application.InputBox(Prompt:="Please enter a Delimiter.", Title:="Tejas Gandhi") For Each eachcell In Myrange Combine = Combine & mydelim & eachcell.Text Next eachcell Set getvalue = Application.InputBox(Prompt:="Select a Cell where you want the Combination.", Title:="dseri", Type:=8) getvalue = Right(Combine, Len(Combine) - 1) End If End Sub One more option is there to create a User Defined Function (UDF) ...

Excel Macro to paste all the images in excel book one after the other Dim MyFolder As String, fn As String, i As Long MyFolder = "C:\Pictures\" If Right$(MyFolder, 1) <> "\" Then MyFolder = MyFolder & "\" fn = Dir(MyFolder & "*.jpg") i = 2 Do While fn <> "" Set p = ActiveSheet.Pictures.Insert(MyFolder & fn) p.Top = i i = i + p.Height + 5 fn = Dir() Loop End Sub

Copy and paste the data entered into a master data worksheet in a different workbook Sub CopyDataMacro() Workbooks.Open "D:\test\MasterData.xlsx" ThisWorkbook.Sheets("test1").Range(A11:K20").Copy Workbooks("MasterData.xlsx").Sheets( "test1").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues ThisWorkbook.Sheets("test1").Range(C5").Copy Workbooks("MasterData.xlsx").Sheets( "test1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues ThisWorkbook.Sheets("test1").Range(C6").Copy Workbooks("MasterData.xlsx").Sheets( "test1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues Workbooks("MasterData.xlsx").Save Workbooks("MasterData.xlsx").Close End Sub

Summary: Inserting picture in worksheet using macro. Details Sub Insert_ImagePic() Dim wks As Worksheet Dim Copies As Variant Dim strPath As String Dim strFileNm As String Dim Pic '-- ' Reference active sheet On Error Resume Next Set wks = ActiveSheet ' Better solution is to reference specified worksheet, e.g.: ' In this example worksheet name = 'ImagePic', customize name Set wks = ThisWorkbook.Worksheets("ImagePic") ' Check if sheet exists If wks Is Nothing Then MsgBox "Active sheet is not Worksheet...'" & vbLf & _ "Please select Worksheet.... and recall procedure.", _ vbExclamation, "Insert ImagePic" Exit Sub End If On Error GoTo 0 ' Initialize File name and Path (you use ComboBox) ' Customize File name and Path strPath = "C:\Users\Andro\Desktop\Articles\avXl...

Excel  macro to send mail automatically Summary : This is example of macro which helps to send mail automatically with attachment of entire Workbook and pasting one particular sheet in the mail body. Function RangetoHTML(rng As Range) ' Changed by Ron de Bruin 28-Oct-2006 ' Working in Office 2000-2010 Dim fso As Object Dim ts As Object Dim TempFile As String Dim TempWB As Workbook TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 'Copy the range and create a new workbook to past the data in rng.Copy Set TempWB = Workbooks.Add(1) With TempWB.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial xlPasteValues, , False, False .Cells(1).PasteSpecial xlPasteFormats, , False, False .Cells(1).Select Application.CutCopyMode = False On Error Resume Next .DrawingObjects.Visible = True ...

Code to automatic page breaks in Excel Sub identify() 'establish v to represent VERTICAL Dim v As Integer: v = 0 ' start loop to identify vertical break Do v = v + 1 ' go through each column at step 1 Loop Until ActiveSheet.Columns(v).PageBreak = xlAutomatic 'continue looping until it identifies a automatic verical (v) page break MsgBox ("Page ends COLUMN : " & v - 1) 'Why "V - 1"? Well, the new page starts on column v... final page therefore is 'column v-1! End Sub

If you want to convert any number to letter then you can use this micro. Its easy to implement just you create new micro and paste this code then in any cell you can call that function. Function ConvertToLetter(iCol As Integer) As String ' Dim iAlpha As Integer ' Dim iRemainder As Integer ' iAlpha = Int(iCol / 27) ' iRemainder = iCol - (iAlpha * 26) ' If iAlpha > 0 Then ' ConvertToLetter = Chr(iAlpha + 64) ' End If ' If iRemainder > 0 Then ' ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64) ' End If Dim columnName As String Dim modulo As Integer While iCol > 0 modulo = (iCol - 1) Mod 26 columnName = Chr(65 + modulo) + columnName iCol = Int((iCol - modulo) / 26) Wend ConvertToLetter = columnName End Function

If you have two column data one is for Id and other is for name then you can get Id base on name data. You can paste this code in your excel micro editor and need to change variable as per your requirement. Sub orange(ByVal Target As Range) For i = 7 To LastRow("_RegistrationDetails_1-1") If Target.Address = ("$O$" & i) Then Dim rng As Range 'set Village ID range [P] Set rng = Worksheets("_RegistrationDetails_1-1").Range("$P$" & i) If Target(1, 1) = "" Then 'clear Village Id [P] rng(1, 1).Value = "" Else 'Village Id [P] Lookup from Taluka name [M] & Village name [O] rng(1, 1).Value = secondarySVlookup("_RegistrationDetails_1-1", "$M$" & i, "$O$" & i, "Village") End If i = LastRow("_RegistrationDetails_1-1") End If Next i End Sub

If you want to use switch case in Excel micro then you can see following example. Its mentioned clearly how to use switch  as per value of cell. Sub configs(ByVal Target As Range) Dim Indexof As Integer Dim strT As String Indexof = InStrRev(Target.Address, "$") strT = Mid(Target.Address, 1, Indexof) Select Case strT Case "$D$" Call drange(Target) 'drange --> generate Crop Id [D],Crop Variety DropDown [E] from Crop Name [C] Case "$E$" Call erange(Target) 'erange --> generate Crop Variety Id [F] from Crop Variety Name [E] Case "$K$" Call krange(Target) 'krange --> generate District Id [L] ,Taluka DropDown [M] from District Name [K] Case "$M$" Call mrange(Target) 'mrange --> generate Taluka Id [N], Village DropDown [O] from Taluka Name [M] Case "$O$" Call orange(Target) 'orange --> generate Village Id [P] from Village Name [O] End Select End...

Set parent child sheet distribution in excel If you want to set excel worksheet as per parent and child sheet then you can try this example. This is simple example to set parent child sheet distribution in excel. Sub Distribution(ByVal destflnm As String, ByVal srcflnm As String, ByVal ParentColumn As String, ByVal ChildColumn As String) 'Clear Destination Sheet Dim RgClear As Range Set RgClear = Worksheets(destflnm).Range("$A$1:$" & LastCol(destflnm) & "$" & LastRow(destflnm)) RgClear.Clear 'Set Parent Range Dim RgParent As Range Set RgParent = Worksheets(srcflnm).Range(ColumnRange(srcflnm, ParentColumn)) 'Set Child Range Dim RgChild As Range Set RgChild = Worksheets(srcflnm).Range(ColumnRange(srcflnm, ChildColumn)) 'Set Search Count Dim i As Integer i = RgParent.Count 'Set Column index for Destination Sheet Dim ci As Integer ci = 1 'Set row index for Destination Sheet ...

Macro code to check duplicate in excel column This is simple Macro code example to check duplicate in excel column. If you have very long list data in single column and have lot of duplicate or redundant data then its headache to find duplicate value. By using following code tricks you can find it easily in excel. Function LastRow(ByVal Filename As String) As Long Dim ix As Long ix = Worksheets(Filename).UsedRange.Row - 1 + Worksheets(Filename).UsedRange.Rows.Count ' ix = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count LastRow = ix End Function Function LastCol(ByVal Filename As String) As String Dim ix As Integer ix = Worksheets(Filename).UsedRange.Column - 1 + Worksheets(Filename).UsedRange.Columns.Count LastCol = ConvertToLetter(ix) End Function Function ConvertToLetter(iCol As Integer) As String ' Dim iAlpha As Integer ' Dim iRemainder As Integer ' iAlpha = Int(iCol / 27) ' iRemainder = iCol...