Public Function FastCut(s As String)
       'returns first n chars which fit pattern *nn?
       Dim x As Long
       Dim flag As Boolean
       Dim a As String
       For x = 1 To Len(s)
           a = a & Mid(s, x, 1)
           If IsNumeric(Right(a, 1)) Then flag = True
           If (flag And Not IsNumeric(Right(a, 1))) Then Exit For
       Next x
       FastCut = a

       End Function

Can you please advise how to fix the following code which uses SUMIFS? I managed to get them together from a lot of sources and I'm aware that there must be something wrong with the data types.

Sub snap2020()

'Declare a variable
    Dim wsOpps As Worksheet, wsSnapshot As Worksheet
    Dim i As Integer, r As Integer
    Dim CatSnapShot As Range

    Dim SumRgn As Range 'The desired Sum Range
    Dim CrtRgn1 As Range 'Range applied to Criteria 1
    Dim Crt1 As Range 'Criteria 1
    Dim CrtRgn2 As Range 'Range applied to Criteria 2
    Dim Crt2 As Range 'Criteria 2
    Dim CrtRgn3 As Range 'Range applied to Criteria 3
    Dim Crt3 As Range 'Criteria 3

    Set SumRgn = ThisWorkbook.Sheets("Opps tracker 2020").Range("T1:T2000")
    Set CrtRgn1 = ThisWorkbook.Sheets("Opps tracker 2020").Range("C1:C2000")
    Set Crt1 = ThisWorkbook.Sheets("Snapshot").Range("$A$3:$A$19")
    Set CrtRgn2 = ThisWorkbook.Sheets("Opps tracker 2020").Range("K1:K2000")
    Set Crt2 = ThisWorkbook.Sheets("Snapshot").Range("$B$1:$K$1")
    Set CrtRgn3 = ThisWorkbook.Sheets("Opps tracker 2020").Range("J1:J2000")
    Set Crt3 = ThisWorkbook.Sheets("Snapshot").Range("$A$2")

    Set wsOpps = ThisWorkbook.Sheets("Opps tracker 2020")
    Set wsSnapshot = ThisWorkbook.Sheets("Snapshot")


'Set up Message Box
    If MsgBox("Update Snapshot?", vbYesNo + vbQuestion + vbDefaultButton2, "Opportunity Snapshot 2020") = vbNo Then
        Exit Sub
    End If

'Turn off events
    Application.EnableEvents = False

'Clear old data in Worksheet Snapshot
    wsSnapshot.Range("B3:K20").ClearContents

'Apply SUMIFs and Update data
    For i = 3 To 19
        For r = 2 To 11
            wsSnapshot.Cells(i, r) _
                = Application.WorksheetFunction.SumIfs(SumRgn, CrtRgn1, Crt1, CrtRgn2, Crt2, CrtRgn3, Crt3)
        Next r
    Next i
'Turn on events
    Application.EnableEvents = True

End Sub

So the purpose of the code is to create a snapshot of the Total number per Model per Category in 2020, 2021, 2022, 2023, and so on. I wanted the results to be populated within the ranges:

1. B3:K20 for Year 2020
2. B22:K39 for Year 2021
3. B41:K58 for Year 2022
4. B60:K77 for Year 2023

The SumIfs statement is supposed to be like this:

=SUMIFS('Opps tracker 2020'!T1:T2000, 'Opps tracker 2020'!C1:C2000, 'Snapshot'!A3:A19, 
'Opps tracker 2020'!K1:K2000, 'Snapshot'!B1:K1, 'Opps tracker 2020'!J1:J2000)

• The sum range I'd like is column T in the "Opps tracker 2020" sheet, this I limited to only the first 2000 rows for testing
• SUMIFs searches for matching Category (column K) in "Opp tracker 2020" sheet that match the Category in "Snapshot" sheet (which is Range B1:K1)
• SUMIFs searches for matching Model (column C) in "Opp tracker 2020" sheet that match the Model in "Snapshot" sheet (range A3:A19 for 2020, A22:A38 for 2021, A41:A57 for 2022, A60:A76 for 2023)
• Then finally SUMIFs has to make sure the Year is 2020 when calculating for Snapshot's 2020 range and same for other years

Here is a print screen of my "Snapshot' sheet

I'm not in anyway a programmer so if you can also suggest a better way to put the codes together, please feel free. I really appreciate any help!

Please advise how to fix this issue. Thanks a lot!

I have three columns in an Excel spreadsheet, First Name, Last Name, and Email

The raw data on those fields like this

Sunny M, Jones, sunnyj@woody.com (the first name including the middle initial on some names)

I want to replace the email address with the format like

FirstName.LastName@whatever.com

The new email address will become

Sunny.M.Jones@whaterver.com

How to do that using formula in a new cell?

Thanks!

i need the help of the community to solve an issue. Basically i have a excel database with a series of information: train number, departure date, fare, owner of the train (NTV or TRN) and the market (which station the train is going to cover).

Now, i have created a code that filter some of those information but i miss a piece: how can I, given a specific market, class and range of departure dates, find FOR EACH TRAIN WITH CXR = "NTV" a train that has a CXR = "TRN"AND has a departure date that falls within plus or minus 40min from the NTV train (i would need to display those information and also the fare)?

I would also need to display the result side by side (preferably also exporting on excel) for a quick and easy comparison. Following, the code. excel file photo

import pandas as pd
import datetime

data = pd.read_excel (r'C:\Users\robda\Downloads\out_ow_train.xlsx')

df = pd.DataFrame(data, columns= ['DDATE','DTRAIN','CLASS','DTIME2','FARE','MARKET','CXR'])
print (df)

NS = ['TRNMXP','TRNPMF','TRNBLQ','TRNFLR','TRNFCO','TRNNAP','TRNQSR','MXPPMF','MXPBLQ','MXPFLR','MXPFCO','MXPNAP','MXPQSR',
  'PMFBLQ','PMFFLR','PMFFCO','PMFNAP','PMFQSR','BLQFLR','BLQFCO','BLQNAP','BLQQSR','FLRFCO',
  'FLRNAP','FLRQSR','FCONAP','FCOQSR','NAPQSR']
dates = ["2020-03-05","2020-03-10"]
classes = ['E']
time = pd.date_range( start = min(dates), end = max(dates), freq='Min')

df.MARKET.isin(NS)
df.DDATE.isin(dates)
df.CLASS.isin(classes)
df.DTIME2.isin(time)

df[df.MARKET.isin(NS) & df.DDATE.isin(dates) & df.CLASS.isin(classes) & df.DTIME2.isin(time)]

P.S. sorry for low quality pic, i have no idea how to update the excel file

This questions is follow up from here. What I need to do now is break up the insert into command in SQL so that I am do not exceed the limitations.

This is what I have so far:

Sub second_export()
Dim sSQL As String, sCnn As String, sServer As String
    Dim db As Object, rs As Object
    sServer = "CATHCART"
    sCnn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=Portfolio_Analytics;Data Source="& sServer & ";"& _
              "Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;"

    Set db = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    If db.State = 0 Then db.Open sCnn

    Dim rw As Range, n As Long
    Dim GLID, category, dt, amount
    PropertyName = ActiveSheet.Range("F2").Value
    InsertedDate = ActiveSheet.Range("G2").Value
    StrSQL = "INSERT INTO SBC_Performance_Metrics VALUES"
    Values = ""
    For Each rw In ActiveSheet.Range("H2:AS47").Rows
        'fixed per-row
        GLID = Trim(rw.Cells(1).Value)
        category = Trim(rw.Cells(2).Value)

        'loopover the date columns
        For n = 3 To rw.Cells.Count

            dt = rw.Cells(n).EntireColumn.Cells(1).Value 'date from Row 1
            amount = rw.Cells(n).Value
            'Debug.Print PropertyName, GLID, category, amount, dt
            Values = Values & "('"& GLID & "', "& "'"& PropertyName & "', "& "'"& category & "', "& amount & ", "& "'"& dt & "', "& "'"& InsertedDate & "'),"'Debug.Print Values
        Next n
    Next rw

    StrSQL = StrSQL & Values
    StrSQL = Left(StrSQL, Len(StrSQL) - 2)
    StrSQL = StrSQL & ");"
    Debug.Print StrSQL
    'Set rs = db.Execute(StrSQL)
End Sub

Everything does what I expect but I need to somehow break up the INSERT INTO part so that I am not going over the 1000 insert limitations.

Any suggestions are greatly appreciated.

I am trying to detect and highlight duplicate with the custom conditional formatting below. However i get an error prompt when i try to do so in the screen shot attached. Can anyone, help me with this?

Much Thanks

I have defined the next formula to enter it as an Array Formula: =IF(LenTableRange(Hoja1!$B$15)=Hoja1!$B$4,IF(OFFSET(LenTableRange(Hoja1!$A$15),0,5)="",LenTableRange(Hoja1!$A$15)))

For some extra info: - LenTableRange returns a range object, the body of the function is:

'Passing a cell as a range, it returns
Function LenTableRange(R As Range) As Range
   Application.Volatile
   Set LenTableRange = Range(R, R.End(xlDown))
End Function

The data i'm taking is Strings in $A$15 > column, numbers in $B$15 > column. Both columns can have repeated values, that's why I filter it, and the column that referes to OFFSET(LenTableRange($B$15);0;5) referes to dates, that could have no value or empty cell.

As you see it has a user defined function in it. The UDF 'LenTableRange' works fine. When I enter the whole formula or the name into a cell it works fine, but when I try the following in VBA:

'I think I have to escape the double quotes as so.
Dim StrForm As String
StrForm = "=IF(LenTablaRango(Hoja1!$B$15)=Hoja1!$B$4,IF(OFFSET(LenTablaRango(Hoja1!$A$15),0,5)="""""",LenTablaRango(Hoja1!$A$15)))"

Debug.Print Application.Evaluate(StrForm)

It gives error 2015. I suspect it is not reading UDFs inside the formula properly. Is it really possible to do this? What is the best way to solve this problem?

I have a dataset that consists of the closing price and date for 10 years. I want to calculate the rolling 3-day volatility of returns data using Exponential Weighted Moving Average. Please mention how to approach this problem and if possible give the solution in excel. The data look like this:

Date        ClosingPrice  Logreturns     Squaredlogretuns  Weights   
1-01-2000    50              -                 -               -
2-01-2000    51            0.008600172     7.3963E-05        0.28    
3-01-2000    52            0.008433168     7.11183E-05       0.2016  
4-01-2000    52.5          0.00415596      1.7272E-05        0.145152    
5-01-2000    53            0.004116566     1.69461E-05       0.10450944  
6-01-2000    59            0.046576142     0.002169337       0.075246797 


Weights * Squaredlog returns      Volatility

2.07096E-05                              -
1.43375E-05                              -
2.50707E-06                               -
1.77103E-06                        0.006270979
0.000163236                        0.013485222

In the above table, I took lambda (weights) =0.72 and used a formula to decrease the weights exponentially. Finally, I multiplied the weights with squared log returns.

I added up all the rows of (weightssquaredlogreturn) column to calculate the overall variance of the EWMA for this data but how to do it for a rolling 3 day period. Above I added up the last 3 rows of (weightsquaredlogreturns) column for each day to get the variance and took a square root of it to get the Standard Deviation or Volatility of rolling 3-day period.

Below is the code, which matches sheet name, then row value, then column headers & sub headers across 2 excel files, & then pastes the value from 1 file to the other.

The code works fine till the second last line, where its copy-pasting the correct data into all cells. However, the last line, which asks to paste the data 1 column after the matched cell in the corresponding cell only ends up pasting data in the final column, and not the columns before that.

[The data in both files is structured in such a way that every other column has headers/sub-headers, so copying the data from 1 cell next shouldnt cause matching problem.]

Sample Input FileSample desired Output

for rows1 in range(1,temp.max_row+1): #iterate over child file's rows
    table=temp.cell(row=rows1,column=2).value #lets check if there is a table starting in each row
    if table=='Table': #have to label the starting of each table in child banner as 'Table' to go identify that a table is starting
        #Function that gives the dimensions of the table in the child banners- 
        table_start=temp.cell(row=rows1,column=2)
        row_count=0 #rows 
        col_count=2 #columns- +1 to accomodate for the sig testing of last category, +1 to accomodate for the 1st column that we used to number tables
        #for rows: start counting at TABLE in column 2 till end of table. 
        for a in range(rows1, temp.max_row+1):
            if (temp.cell(row=a, column=2).value==None and temp.cell(row=a+1, column=2).value==None): #check if cell is not empty
                break
            else:
                row_count=row_count+1
        #for columns:start counting at Table in the top row till end of table+1
        for b in range(2,temp.max_column+1):
            if (temp.cell(row=rows1, column=b).value==None and temp.cell(row=rows1,column=b+1).value==None):
                break
            else:
                col_count = col_count+1

        for rows2 in range(rows1+2,rows1+row_count):
            banner=temp.cell(row=rows2,column=2).value
            question=temp.cell(row=rows2,column=3).value
            subq=temp.cell(row=rows2,column=4).value
            for i in book1.worksheets: #iterates over the multiple worksheets/banners in parent file
                if i.title==banner: #checks if the banner mentioned in child file exists in parent file
                    for rowsa in range(1,i.max_row+1): #iterates over rows in the parent banner opened
                        if question==i.cell(row=rowsa,column=1).value: #goes ahead only if question in child file is found in the parent banner
                            if i.cell(row=rowsa+4, column=1).value=='Total': #checks if cell has value 'Total' 4 cells below the cell containing the question in the parent banner
                                #Function that gives the dimensions of the table in the parent banners-
                                r_count=2 #count from cell containing 'total' till it encounters an empty cell, & add 2 to include the heading & subheading
                                c_count=1 #count from cell containing 'total' till last column, & add 1 to include sig testing in the last column
                                #for rows: match question in the parent banner, find the first total below it. the table starts 2 rows above the cell containing 'total' so as to contain the header & sub-header
                                for c in range(rowsa+4, i.max_row+1):
                                    if i.cell(row=c, column=1).value==None: #check if cell is not empty
                                        break
                                    else:
                                        r_count=r_count+1

                                #for columns: CORRECT
                                for d in range(1,i.max_column+1):
                                    if (i.cell(row=rowsa+4, column=d).value==None and i.cell(row=rowsa+4,column=d+1).value==None):
                                         break
                                    else:
                                        c_count = c_count+1

                            #Now comes the matching from child banner to parent banners- 
                            for rowsb in range(rowsa+4,rowsa+4+r_count):
                                if subq==i.cell(row=rowsb,column=1).value:
                                    for cols1 in range(5,col_count):
                                        header = temp.cell(row=table_start.row,column=cols1).value #2 rows above the row containing base numbers(total)
                                        sub_header = temp.cell(row=table_start.row+1,column=cols1).value #1 row above the row containing base numbers(total)
                                        for colsa in range(2,c_count):
                                            if header==i.cell(row=5,column=colsa).value:
                                                if sub_header==i.cell(row=6,column=colsa).value:
                                                    temp.cell(row=rows2,column=cols1).value=i.cell(row=rowsb,column=colsa).value #works till here
                                                    temp.cell(row=rows2,column=cols1+1).value=i.cell(row=rowsb,column=colsa+1).value

I regularly receive workbooks from business partners. They all use the same template. What I'd like to do is pull in the partner name (always in the same cell) L1 and the "Totals:"(Column B) for the month which always remain in the same column (column CR), but may change rows based on the number of line items that add up to the total. As you can imagine, going through to manually find and transcribe this information to another workbook in order to get a summary of the past month's activities is tedious and open for error.

Some code that I found on excelvbaisfun.com was designed to combine multiple files, but seems to be for nicely formatted data.

I have never written VBA before, so all help is welcome.

Sub getDataFromWbs()

Dim wb As Workbook, ws As Worksheet
Set fso = CreateObject(“Scripting.FileSystemObject”)

‘This is where you put YOUR folder name
Set fldr = fso.GetFolder(“C:\temp\”)

‘Next available Row on Master Workbook
y = ThisWorkbook.Sheets(“sheet1”).Cells(Rows.Count, 1).End(xlUp).Row + 1

‘Loop through each file in that folder
For Each wbFile In fldr.Files

‘Make sure looping only through files ending in .xlsx (Excel files)
If fso.GetExtensionName(wbFile.Name) = “xlsx” Then

‘Open current book
Set wb = Workbooks.Open(wbFile.Path)

‘Loop through each sheet (ws)
For Each ws In wb.Sheets
‘Last row in that sheet (ws)
wsLR = ws.Cells(Rows.Count, 1).End(xlUp).Row

‘Loop through each record (row 2 through last row)
For x = 2 To wsLR
‘Put column 1,2,3 and 4 of current sheet (ws) into row y of master sheet, then increase row y to next row
ThisWorkbook.Sheets(“sheet1”).Cells(y, 1) = ws.Cells(x, 1) ‘col 1
ThisWorkbook.Sheets(“sheet1”).Cells(y, 2) = ws.Cells(x, 2)
ThisWorkbook.Sheets(“sheet1”).Cells(y, 3) = CDate(ws.Cells(x, 3))
ThisWorkbook.Sheets(“sheet1”).Cells(y, 4) = ws.Cells(x, 4)
y = y + 1
Next x

Next ws

‘Close current book
wb.Close
End If

Next wbFile

End Sub

My code is as below:

Sub NewWorksheetTest()
    Dim wsname As String
    wsname = InputBox("Enter a name for the new worksheet")

    On Error GoTo BadEntry
        Sheets.Add
        ActiveSheet.Name = wsname
        Exit Sub

BadEntry:
    MsgBox Err.Number & " :"& Err.Description, vbInformation, "There is an error...."

End Sub

My understanding is when i input something bad(e.g.duplicated names or names containing ?/), there is a message explaining the reasons and at the same time system stops a new sheet from being added. However when I try, the error msg is there but a new sheet keeps on being added to the workbook. Can anyone solve this please?:)

If I have A1= 1,2,3,4,5,6,7,8,9

A2=2,6,9

My desired result should be in cell A3 After substation (A1-A2) =1,3,4,5,7,8

while it was very easy when A2=2,3,4 (serially) via substitute function.

I have been reading up on how to read and combine multiple xlsx files into one R data frame and have come across some very good suggestions like, How to read multiple xlsx file in R using loop with specific rows and columns, but non fits my data set so far.

I would like R to read in multiple xlsx files with that have multiple sheets. All sheets and files have the same columns but not the same length and NA's should be excluded. I want to skip the first 3 rows and only take in columns 1:6, 8:10, 12:17, 19.

So far I tried:

file.list <- list.files(recursive=T,pattern='*.xlsx')

dat = lapply(file.list, function(i){
    x = read.xlsx(i, sheetIndex=1, sheetName=NULL, startRow=4,
              endRow=NULL, as.data.frame=TRUE, header=F)
# Column select 
    x = x[, c(1:6,8:10,12:17,19)]
# Create column with file name  
    x$file = i
# Return data
    x
  })

  dat = do.call("rbind.data.frame", dat)

But this only takes all the first sheet of every file

Does anyone know how to get all the sheets and files together in one R data frame?

Also, what packages would you recommend for large sets of data? So far I tried readxl and XLConnect.

I am trying to get this macro run automatically when a value in the target cell changes but it's not working, searched solutions for hours but am still hitting the wall, sorry I am new to VBA. Really appreciate it if any kind soul could help.

My code is below:

Sub Hide_Row()
Dim rng As Range
Dim cell As Range
Set rng = Sheets("PL").Range("F32:F35,F41:F44,F50:F53,F59:F62")
    For Each cell In rng
        If cell.Value = 0 Then
            cell.EntireRow.Hidden = True
        Else
            cell.EntireRow.Hidden = False
        End If
    Next
Dim MyRange As Range
Set MyRange = Sheets("PL").Range("E30")
        If MyRange.Value = "0" Then
            Sheets("PL").Rows("30:31").EntireRow.Hidden = True
        Else
            Sheets("PL").Rows("30:31").EntireRow.Hidden = False
End If
Set MyRange = Sheets("PL").Range("E39")
        If MyRange.Value = "0" Then
            Sheets("PL").Rows("39:40").EntireRow.Hidden = True
        Else
            Sheets("PL").Rows("39:40").EntireRow.Hidden = False
End If
Set MyRange = Sheets("PL").Range("E48")
        If MyRange.Value = "0" Then
            Sheets("PL").Rows("48:49").EntireRow.Hidden = True
        Else
            Sheets("PL").Rows("48:49").EntireRow.Hidden = False
End If
End Sub

Already circled the internet and has the same answer that did not work as I wanted to be.

Q: How to hide workbook and show userform without hiding other workbook?

This code is good but hides other workbooks.

Application.Visible = False

This code is bad as it still shows the excel application.

Workbooks("Workbook Name.xlsm").Window(1).Visible = False

Also dont work.

ActiveWorkbook.Visible = False

Lastly, the tool method, going to tools>options>general tab>ignore other application. I dont have this option on my VBA

This is the code I used.

Private Sub UserForm_Initialize()
If Application.Windows.Count > 1 Then
Application.Windows(ThisWorkbook.Name).Visible = False
Else
Application.Visible = False
End If

and in ThisWorkbook module

Private Sub Workbook_Open()
UserForm1.Show
End Sub

I have search and search for an answer to my code issue but I cant find any. I will be very grateful if someone can take a look at my code. At the moment, I have several large workbooks for data for each country. Each workbook has more that 5 work sheets. I want to consolidate the workbooks into a master file. First, I wan to copy and paste all worksheets under one work sheet in the master workbook and name it all by the country. Right now, my code is only able to consolidate one country at a time which makes it very slow. also the loop worksheet seems to the failing. It creates only one country worksheet. If I put in multiple country names, only the last country workbook gets consolidated. Something is missing but I cant seem to figure it out. Thank you so much!!!! Below is my code:

Sub consolidate()

   Application.EnableCancelKey = xlDisabled

   Dim folderPath As String
   Dim Filename As String
   Dim wb As Workbook
   Dim Masterwb  As Workbook
   Dim sh As Worksheet
   Dim NewSht As Worksheet
   Dim FindRng As Range
   Dim PasteRow As Long

   Dim countryname As String
   Dim LastRow, Rowlast, Rowlast2 As Long
   Const fr As Long = 2
   Dim i As Long
   Dim cell As Range
   Dim wx As Worksheet
   Set wx = ThisWorkbook.Sheets("Countryname")
   Rowlast = wx.Range("B"& Rows.Count).End(xlDown).row 'selects list of country workbook I want to consolidate. e.g I could have Germany, usa, china
   Rowlast2 = wx.Range("C"& Rows.Count).End(xlDown).row 'selects list of tabs for each country workbook I want to consolidate, e.g I want for every country listed above, that sheet names 1, 2, 3, 4 be consolidated and put in new worksheets in the masterfile

   With wx
      For LastRow = fr To Rowlast
         If .Cells(LastRow, "B").Value <> "" Then
            countryname = .Cells(LastRow, "B").Value
            ' set master workbook
            Set Masterwb = Workbooks("ebele_test.xlsm")
            folderPath = Application.InputBox(Prompt:= _
                  "Please enter only folder path in this format as C:\Users\...  Exclude the file name", _
            Title:="InputBox Method", Type:=2) 'Type:=2 = text

            If folderPath = "False" Or IsError(folderPath) Then 'If Cancel is clicked on Input Box exit sub

               MsgBox "Incorrect Input, Please paste correct folder path"
               Exit Sub
               'On Error GoTo 0

            End If
            If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
            Application.ScreenUpdating = False
            Dim str As String
            str = "Screener_User_Template-"

            Filename = Dir(folderPath & str & countryname & "*.xlsx")
            Do While Filename <> ""
               Set wb = Workbooks.Open(folderPath & Filename)

               If Len(wb.Name) > 253 Then
                  MsgBox "Sheet's name can be up to 253 characters long, shorten the Excel file name"
                  wb.Close False
                  GoTo Exit_Loop
               Else
                  ' add a new sheet with the file's name (remove the extension)
                  With Masterwb
                     Dim isLastSheet As Boolean
                     Dim ci, rows1 As Integer
                     Dim row As Long
                     rows1 = ThisWorkbook.Worksheets.Count
                     For ci = rows1 To 1 Step (-1)
                        If (isLastSheet) = False Then
                           Set NewSht = Masterwb.Worksheets.Add(After:=Worksheets(ci)) 'Place sheet at the end.
                           NewSht.Cells(1, 1) = "Identifier"
                           NewSht.Cells(1, 2) = "Company Name"
                           NewSht.Cells(1, 3) = "Country of Incorporation"
                           NewSht.Name = countryname
                        End If
                     Next ci
                  End With

               End If

               ' loop through all sheets in opened wb

               For Each sh In wb.Worksheets
                  For i = 2 To Rowlast2
                     If sh.Name = wx.Cells(i, "C").Value And NewSht.Name = countryname Then
                        ' get the first empty row in the new sheet

                        Set FindRng = NewSht.Cells.Find(What:="*", Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)

                        If Not FindRng Is Nothing Then ' If find is successful
                           PasteRow = FindRng.row + 1
                        Else ' find was unsuccessfull > new empty sheet, should paste at the second row
                           PasteRow = 2
                        End If

                        Dim rng As Range
                        Set rng = sh.Range(sh.Cells(3, "A"), sh.Cells(150000, "M"))
                        rng.Copy

                        NewSht.Range("A"& PasteRow).PasteSpecial xlPasteValues

                     End If
                     Application.CutCopyMode = False 'Clears the clipboard
                  Next i
               Next sh
               wb.Close False
Exit_Loop:
               Set wb = Nothing
               Filename = Dir
            Loop
         End If
      Next LastRow
   End With
   '0:  Exit Sub
   Application.ScreenUpdating = True
End Sub

The code returning an error is the first line of the following:

    While StrComp(selectedRecipe, dataSheet.Cells(i, 1)) <> 0
             recipeRow = recipeRow + 1
             i = i + 1
    Wend

The debug I'm getting has issues with the While statement line itself. This code is contained under an OK Button click event on a userform, with selectedRecipe defined as a public string variable in the main worksheet sub. "i" is defined as an integer in this private sub. Basically the code is to find which row of the sheet holds the string value contained in selectedRecipe after selectedRecipe is selected from a drop-down combo box (selectedRecipe returns correctly and has no issues associated with it). I assume I need to have some sort of "converting" command in front of "dataSheet.Cells(i,1)" to reinforce the cell value as a string, but am not sure. Thanks!

I was not sure how to really create the question... But the problem I am having is this: I have a list (in rows) that relate to a regulatory document, and after trying to create some sort of for loop or elaborate VLookUp/Index formula, I'm requesting help. For example:

Now I want to use the rows to find the corresponding section in the document. I've already extracted and formatted the compliance document so it is in excel format.

So what I really need is this: a formula or VBA script that can 1. take the compliance number (for example 1A-1 which exist in Cell A3) and go find a cell (in single column D) that has JUST 1A-1, not 1A-1.1, not 1A-1.1.2, etc. and return it to the adjacent cell to 1A-1, for example.

Many thanks ahead of time... I am so lost!! :/

I'd like to set the value of a const variable conditionally at Compile time. I thought i could achieve this using vba compiler directives #If #Else etc. as below, but have been unsuccessful so far:

#If Environ("username") = "myusername" Then
    Public Const ErrorHandling As Boolean = False
#Else
    Public Const ErrorHandling As Boolean = True
#End If

When i run this code, im getting an error that the Environ variable is undefined.
Would something like this even be possible? Or do i just have to make my 'ErrorHandling' variable Public (not Const), and set it at the initialisation of my code?

Thanks in advance,
cjk

I am trying to figure out a way to cycle through active borders in Excel and to change their colors to "next one" with each macro run.

Here is the code I've got:

Dim Color1 As Variant
Dim Color2 As Variant
Dim Color3 As Variant
Dim Color4 As Variant
Dim Color5 As Variant

Color_default = RGB(0, 0, 0)
Color1 = RGB(255, 0, 0)
Color2 = RGB(0, 255, 0)
Color3 = RGB(0, 0, 255)
Color4 = RGB(222, 111, 155)
Color5 = RGB(111, 111, 111)

Dim cell As Range
Dim positions As Variant
Dim i As Integer

positions = Array(xlDiagonalDown, xlDiagonalDown, xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal)

For Each cell In Selection
    For i = LBound(positions) To UBound(positions)
        If cell.BORDERS(positions(i)).LineStyle <> xlNone Then
            If cell.BORDERS(positions(i)).Color = Color_default Then
                cell.BORDERS(positions(i)).Color = Color1
            ElseIf cell.BORDERS(positions(i)).Color = Color1 Then
                cell.BORDERS(positions(i)).Color = Color2
            ElseIf cell.BORDERS(positions(i)).Color = Color2 Then
                cell.BORDERS(positions(i)).Color = Color3
            ElseIf cell.BORDERS(positions(i)).Color = Color3 Then
                cell.BORDERS(positions(i)).Color = Color4
            ElseIf cell.BORDERS(positions(i)).Color = Color4 Then
                cell.BORDERS(positions(i)).Color = Color5
            Else
                cell.BORDERS(positions(i)).Color = Color_default
            End If
        End If
    Next i
Next cell

It works. It does not change the weight of the borders and it does not add new borders (only changes the existing ones). The issue is that when two cells are nearby, the outer borders are changes to "next+1" color, and the inner borders are changed to "next+2" color, as they are looped through two times...

I have been thinking about the solution to this for quite a while now, but I cannot find any way to solve it.

Anyone willing to help? Thanks!